diff --git a/ice-9/psyntax.pp b/ice-9/psyntax.pp index f30697a78..605403444 100644 --- a/ice-9/psyntax.pp +++ b/ice-9/psyntax.pp @@ -1,11 +1,11 @@ -(letrec ((lambda-var-list (lambda (vars203) (let lvl ((vars204 vars203) (ls (quote ())) (w205 (quote (())))) (cond ((pair? vars204) (lvl (cdr vars204) (cons (wrap (car vars204) w205) ls) w205)) ((id? vars204) (cons (wrap vars204 w205) ls)) ((null? vars204) ls) ((syntax-object? vars204) (lvl (syntax-object-expression vars204) ls (join-wraps w205 (syntax-object-wrap vars204)))) ((annotation? vars204) (lvl (annotation-expression vars204) ls w205)) (else (cons vars204 ls)))))) (gen-var (lambda (id206) (let ((id207 (if (syntax-object? id206) (syntax-object-expression id206) id206))) (if (annotation? id207) (gensym (annotation-expression id207) generated-symbols) (gensym id207 generated-symbols))))) (strip (lambda (x208 w209) (if (memq (quote top) (wrap-marks w209)) (if (or (annotation? x208) (and (pair? x208) (annotation? (car x208)))) (strip-annotation x208 (quote #f)) x208) (let f210 ((x211 x208)) (cond ((syntax-object? x211) (strip (syntax-object-expression x211) (syntax-object-wrap x211))) ((pair? x211) (let ((a (f210 (car x211))) (d (f210 (cdr x211)))) (if (and (eq? a (car x211)) (eq? d (cdr x211))) x211 (cons a d)))) ((vector? x211) (let ((old212 (vector->list x211))) (let ((new213 (map f210 old212))) (if (andmap eq? old212 new213) x211 (list->vector new213))))) (else x211)))))) (strip-annotation (lambda (x214 parent) (cond ((pair? x214) (let ((new215 (cons (quote #f) (quote #f)))) (begin (when parent (set-annotation-stripped! parent new215)) (set-car! new215 (strip-annotation (car x214) (quote #f))) (set-cdr! new215 (strip-annotation (cdr x214) (quote #f))) new215))) ((annotation? x214) (or (annotation-stripped x214) (strip-annotation (annotation-expression x214) x214))) ((vector? x214) (let ((new216 (make-vector (vector-length x214)))) (begin (when parent (set-annotation-stripped! parent new216)) (let loop ((i217 (- (vector-length x214) (quote 1)))) (unless (fx< i217 (quote 0)) (vector-set! new216 i217 (strip-annotation (vector-ref x214 i217) (quote #f))) (loop (fx- i217 (quote 1))))) new216))) (else x214)))) (ellipsis? (lambda (x218) (and (nonsymbol-id? x218) (free-id=? x218 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))))))) (chi-void (lambda () (list (quote void)))) (eval-local-transformer (lambda (expanded) (let ((p (local-eval-hook expanded))) (if (procedure? p) p (syntax-error p (quote "nonprocedure transfomer")))))) (chi-local-syntax (lambda (rec? e219 r w220 s k) ((lambda (tmp221) ((lambda (tmp222) (if tmp222 (apply (lambda (_223 id224 val e1 e2) (let ((ids225 id224)) (if (not (valid-bound-ids? ids225)) (syntax-error e219 (quote "duplicate bound keyword in")) (let ((labels (gen-labels ids225))) (let ((new-w (make-binding-wrap ids225 labels w220))) (k (cons e1 e2) (extend-env labels (let ((w228 (if rec? new-w w220)) (trans-r (macros-only-env r))) (map (lambda (x229) (cons (quote macro) (eval-local-transformer (chi x229 trans-r w228)))) val)) r) new-w s)))))) tmp222) ((lambda (_231) (syntax-error (source-wrap e219 w220 s))) tmp221))) (syntax-dispatch tmp221 (quote (any #(each (any any)) any . each-any))))) e219))) (chi-lambda-clause (lambda (e232 c r233 w234 k235) ((lambda (tmp236) ((lambda (tmp237) (if tmp237 (apply (lambda (id238 e1239 e2240) (let ((ids241 id238)) (if (not (valid-bound-ids? ids241)) (syntax-error e232 (quote "invalid parameter list in")) (let ((labels243 (gen-labels ids241)) (new-vars (map gen-var ids241))) (k235 new-vars (chi-body (cons e1239 e2240) e232 (extend-var-env labels243 new-vars r233) (make-binding-wrap ids241 labels243 w234))))))) tmp237) ((lambda (tmp245) (if tmp245 (apply (lambda (ids246 e1247 e2248) (let ((old-ids (lambda-var-list ids246))) (if (not (valid-bound-ids? old-ids)) (syntax-error e232 (quote "invalid parameter list in")) (let ((labels249 (gen-labels old-ids)) (new-vars250 (map gen-var old-ids))) (k235 (let f251 ((ls1 (cdr new-vars250)) (ls2 (car new-vars250))) (if (null? ls1) ls2 (f251 (cdr ls1) (cons (car ls1) ls2)))) (chi-body (cons e1247 e2248) e232 (extend-var-env labels249 new-vars250 r233) (make-binding-wrap old-ids labels249 w234))))))) tmp245) ((lambda (_253) (syntax-error e232)) tmp236))) (syntax-dispatch tmp236 (quote (any any . each-any)))))) (syntax-dispatch tmp236 (quote (each-any any . each-any))))) c))) (chi-body (lambda (body outer-form r254 w255) (let ((r256 (cons (quote ("placeholder" placeholder)) r254))) (let ((ribcage (make-ribcage (quote ()) (quote ()) (quote ())))) (let ((w257 (make-wrap (wrap-marks w255) (cons ribcage (wrap-subst w255))))) (let parse ((body258 (map (lambda (x262) (cons r256 (wrap x262 w257))) body)) (ids259 (quote ())) (labels260 (quote ())) (vars261 (quote ())) (vals (quote ())) (bindings (quote ()))) (if (null? body258) (syntax-error outer-form (quote "no expressions in body")) (let ((e263 (cdar body258)) (er (caar body258))) (call-with-values (lambda () (syntax-type e263 er (quote (())) (quote #f) ribcage)) (lambda (type264 value265 e266 w267 s268) (let ((t type264)) (if (memv t (quote (define-form))) (let ((id269 (wrap value265 w267)) (label (gen-label))) (let ((var270 (gen-var id269))) (begin (extend-ribcage! ribcage id269 label) (parse (cdr body258) (cons id269 ids259) (cons label labels260) (cons var270 vars261) (cons (cons er (wrap e266 w267)) vals) (cons (cons (quote lexical) var270) bindings))))) (if (memv t (quote (define-syntax-form))) (let ((id271 (wrap value265 w267)) (label272 (gen-label))) (begin (extend-ribcage! ribcage id271 label272) (parse (cdr body258) (cons id271 ids259) (cons label272 labels260) vars261 vals (cons (cons (quote macro) (cons er (wrap e266 w267))) bindings)))) (if (memv t (quote (begin-form))) ((lambda (tmp273) ((lambda (tmp274) (if tmp274 (apply (lambda (_275 e1276) (parse (let f277 ((forms e1276)) (if (null? forms) (cdr body258) (cons (cons er (wrap (car forms) w267)) (f277 (cdr forms))))) ids259 labels260 vars261 vals bindings)) tmp274) (syntax-error tmp273))) (syntax-dispatch tmp273 (quote (any . each-any))))) e266) (if (memv t (quote (local-syntax-form))) (chi-local-syntax value265 e266 er w267 s268 (lambda (forms279 er280 w281 s282) (parse (let f283 ((forms284 forms279)) (if (null? forms284) (cdr body258) (cons (cons er280 (wrap (car forms284) w281)) (f283 (cdr forms284))))) ids259 labels260 vars261 vals bindings))) (if (null? ids259) (build-sequence (quote #f) (map (lambda (x285) (chi (cdr x285) (car x285) (quote (())))) (cons (cons er (source-wrap e266 w267 s268)) (cdr body258)))) (begin (if (not (valid-bound-ids? ids259)) (syntax-error outer-form (quote "invalid or duplicate identifier in definition"))) (let loop286 ((bs bindings) (er-cache (quote #f)) (r-cache (quote #f))) (if (not (null? bs)) (let ((b (car bs))) (if (eq? (car b) (quote macro)) (let ((er287 (cadr b))) (let ((r-cache288 (if (eq? er287 er-cache) r-cache (macros-only-env er287)))) (begin (set-cdr! b (eval-local-transformer (chi (cddr b) r-cache288 (quote (()))))) (loop286 (cdr bs) er287 r-cache288)))) (loop286 (cdr bs) er-cache r-cache))))) (set-cdr! r256 (extend-env labels260 bindings (cdr r256))) (build-letrec (quote #f) vars261 (map (lambda (x289) (chi (cdr x289) (car x289) (quote (())))) vals) (build-sequence (quote #f) (map (lambda (x290) (chi (cdr x290) (car x290) (quote (())))) (cons (cons er (source-wrap e266 w267 s268)) (cdr body258)))))))))))))))))))))) (chi-macro (lambda (p291 e292 r293 w294 rib) (letrec ((rebuild-macro-output (lambda (x295 m) (cond ((pair? x295) (cons (rebuild-macro-output (car x295) m) (rebuild-macro-output (cdr x295) m))) ((syntax-object? x295) (let ((w296 (syntax-object-wrap x295))) (let ((ms (wrap-marks w296)) (s297 (wrap-subst w296))) (make-syntax-object (syntax-object-expression x295) (if (and (pair? ms) (eq? (car ms) (quote #f))) (make-wrap (cdr ms) (if rib (cons rib (cdr s297)) (cdr s297))) (make-wrap (cons m ms) (if rib (cons rib (cons (quote shift) s297)) (cons (quote shift) s297)))))))) ((vector? x295) (let ((n (vector-length x295))) (let ((v (make-vector n))) (let doloop ((i298 (quote 0))) (if (fx= i298 n) v (begin (vector-set! v i298 (rebuild-macro-output (vector-ref x295 i298) m)) (doloop (fx+ i298 (quote 1))))))))) ((symbol? x295) (syntax-error x295 (quote "encountered raw symbol in macro output"))) (else x295))))) (rebuild-macro-output (p291 (wrap e292 (anti-mark w294))) (string (quote #\m)))))) (chi-application (lambda (x299 e300 r301 w302 s303) ((lambda (tmp304) ((lambda (tmp305) (if tmp305 (apply (lambda (e0 e1306) (cons x299 (map (lambda (e307) (chi e307 r301 w302)) e1306))) tmp305) (syntax-error tmp304))) (syntax-dispatch tmp304 (quote (any . each-any))))) e300))) (chi-expr (lambda (type309 value310 e311 r312 w313 s314) (let ((t315 type309)) (if (memv t315 (quote (lexical))) value310 (if (memv t315 (quote (core))) (value310 e311 r312 w313 s314) (if (memv t315 (quote (lexical-call))) (chi-application value310 e311 r312 w313 s314) (if (memv t315 (quote (global-call))) (chi-application value310 e311 r312 w313 s314) (if (memv t315 (quote (constant))) (list (quote quote) (strip (source-wrap e311 w313 s314) (quote (())))) (if (memv t315 (quote (global))) value310 (if (memv t315 (quote (call))) (chi-application (chi (car e311) r312 w313) e311 r312 w313 s314) (if (memv t315 (quote (begin-form))) ((lambda (tmp316) ((lambda (tmp317) (if tmp317 (apply (lambda (_318 e1319 e2320) (chi-sequence (cons e1319 e2320) r312 w313 s314)) tmp317) (syntax-error tmp316))) (syntax-dispatch tmp316 (quote (any any . each-any))))) e311) (if (memv t315 (quote (local-syntax-form))) (chi-local-syntax value310 e311 r312 w313 s314 chi-sequence) (if (memv t315 (quote (eval-when-form))) ((lambda (tmp322) ((lambda (tmp323) (if tmp323 (apply (lambda (_324 x325 e1326 e2327) (let ((when-list (chi-when-list e311 x325 w313))) (if (memq (quote eval) when-list) (chi-sequence (cons e1326 e2327) r312 w313 s314) (chi-void)))) tmp323) (syntax-error tmp322))) (syntax-dispatch tmp322 (quote (any each-any any . each-any))))) e311) (if (memv t315 (quote (define-form define-syntax-form))) (syntax-error (wrap value310 w313) (quote "invalid context for definition of")) (if (memv t315 (quote (syntax))) (syntax-error (source-wrap e311 w313 s314) (quote "reference to pattern variable outside syntax form")) (if (memv t315 (quote (displaced-lexical))) (syntax-error (source-wrap e311 w313 s314) (quote "reference to identifier outside its scope")) (syntax-error (source-wrap e311 w313 s314)))))))))))))))))) (chi (lambda (e330 r331 w332) (call-with-values (lambda () (syntax-type e330 r331 w332 (quote #f) (quote #f))) (lambda (type333 value334 e335 w336 s337) (chi-expr type333 value334 e335 r331 w336 s337))))) (chi-top (lambda (e338 r339 w340 m341 esew) (call-with-values (lambda () (syntax-type e338 r339 w340 (quote #f) (quote #f))) (lambda (type348 value349 e350 w351 s352) (let ((t353 type348)) (if (memv t353 (quote (begin-form))) ((lambda (tmp354) ((lambda (tmp355) (if tmp355 (apply (lambda (_356) (chi-void)) tmp355) ((lambda (tmp357) (if tmp357 (apply (lambda (_358 e1359 e2360) (chi-top-sequence (cons e1359 e2360) r339 w351 s352 m341 esew)) tmp357) (syntax-error tmp354))) (syntax-dispatch tmp354 (quote (any any . each-any)))))) (syntax-dispatch tmp354 (quote (any))))) e350) (if (memv t353 (quote (local-syntax-form))) (chi-local-syntax value349 e350 r339 w351 s352 (lambda (body362 r363 w364 s365) (chi-top-sequence body362 r363 w364 s365 m341 esew))) (if (memv t353 (quote (eval-when-form))) ((lambda (tmp366) ((lambda (tmp367) (if tmp367 (apply (lambda (_368 x369 e1370 e2371) (let ((when-list372 (chi-when-list e350 x369 w351)) (body373 (cons e1370 e2371))) (cond ((eq? m341 (quote e)) (if (memq (quote eval) when-list372) (chi-top-sequence body373 r339 w351 s352 (quote e) (quote (eval))) (chi-void))) ((memq (quote load) when-list372) (if (or (memq (quote compile) when-list372) (and (eq? m341 (quote c&e)) (memq (quote eval) when-list372))) (chi-top-sequence body373 r339 w351 s352 (quote c&e) (quote (compile load))) (if (memq m341 (quote (c c&e))) (chi-top-sequence body373 r339 w351 s352 (quote c) (quote (load))) (chi-void)))) ((or (memq (quote compile) when-list372) (and (eq? m341 (quote c&e)) (memq (quote eval) when-list372))) (top-level-eval-hook (chi-top-sequence body373 r339 w351 s352 (quote e) (quote (eval)))) (chi-void)) (else (chi-void))))) tmp367) (syntax-error tmp366))) (syntax-dispatch tmp366 (quote (any each-any any . each-any))))) e350) (if (memv t353 (quote (define-syntax-form))) (let ((n376 (id-var-name value349 w351)) (r377 (macros-only-env r339))) (let ((t378 m341)) (if (memv t378 (quote (c))) (if (memq (quote compile) esew) (let ((e379 (chi-install-global n376 (chi e350 r377 w351)))) (begin (top-level-eval-hook e379) (if (memq (quote load) esew) e379 (chi-void)))) (if (memq (quote load) esew) (chi-install-global n376 (chi e350 r377 w351)) (chi-void))) (if (memv t378 (quote (c&e))) (let ((e380 (chi-install-global n376 (chi e350 r377 w351)))) (begin (top-level-eval-hook e380) e380)) (begin (if (memq (quote eval) esew) (top-level-eval-hook (chi-install-global n376 (chi e350 r377 w351)))) (chi-void)))))) (if (memv t353 (quote (define-form))) (let ((n381 (id-var-name value349 w351))) (let ((t382 (binding-type (lookup n381 r339)))) (if (memv t382 (quote (global))) (let ((x383 (list (quote define) n381 (chi e350 r339 w351)))) (begin (if (eq? m341 (quote c&e)) (top-level-eval-hook x383)) x383)) (if (memv t382 (quote (displaced-lexical))) (syntax-error (wrap value349 w351) (quote "identifier out of context")) (syntax-error (wrap value349 w351) (quote "cannot define keyword at top level")))))) (let ((x384 (chi-expr type348 value349 e350 r339 w351 s352))) (begin (if (eq? m341 (quote c&e)) (top-level-eval-hook x384)) x384)))))))))))) (syntax-type (lambda (e385 r386 w387 s388 rib389) (cond ((symbol? e385) (let ((n390 (id-var-name e385 w387))) (let ((b391 (lookup n390 r386))) (let ((type392 (binding-type b391))) (let ((t393 type392)) (if (memv t393 (quote (lexical))) (values type392 (binding-value b391) e385 w387 s388) (if (memv t393 (quote (global))) (values type392 n390 e385 w387 s388) (if (memv t393 (quote (macro))) (syntax-type (chi-macro (binding-value b391) e385 r386 w387 rib389) r386 (quote (())) s388 rib389) (values type392 (binding-value b391) e385 w387 s388))))))))) ((pair? e385) (let ((first (car e385))) (if (id? first) (let ((n394 (id-var-name first w387))) (let ((b395 (lookup n394 r386))) (let ((type396 (binding-type b395))) (let ((t397 type396)) (if (memv t397 (quote (lexical))) (values (quote lexical-call) (binding-value b395) e385 w387 s388) (if (memv t397 (quote (global))) (values (quote global-call) n394 e385 w387 s388) (if (memv t397 (quote (macro))) (syntax-type (chi-macro (binding-value b395) e385 r386 w387 rib389) r386 (quote (())) s388 rib389) (if (memv t397 (quote (core))) (values type396 (binding-value b395) e385 w387 s388) (if (memv t397 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value b395) e385 w387 s388) (if (memv t397 (quote (begin))) (values (quote begin-form) (quote #f) e385 w387 s388) (if (memv t397 (quote (eval-when))) (values (quote eval-when-form) (quote #f) e385 w387 s388) (if (memv t397 (quote (define))) ((lambda (tmp398) ((lambda (tmp399) (if (if tmp399 (apply (lambda (_400 name401 val402) (id? name401)) tmp399) (quote #f)) (apply (lambda (_403 name404 val405) (values (quote define-form) name404 val405 w387 s388)) tmp399) ((lambda (tmp406) (if (if tmp406 (apply (lambda (_407 name408 args409 e1410 e2411) (and (id? name408) (valid-bound-ids? (lambda-var-list args409)))) tmp406) (quote #f)) (apply (lambda (_412 name413 args414 e1415 e2416) (values (quote define-form) (wrap name413 w387) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) (wrap (cons args414 (cons e1415 e2416)) w387)) (quote (())) s388)) tmp406) ((lambda (tmp418) (if (if tmp418 (apply (lambda (_419 name420) (id? name420)) tmp418) (quote #f)) (apply (lambda (_421 name422) (values (quote define-form) (wrap name422 w387) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote (())) s388)) tmp418) (syntax-error tmp398))) (syntax-dispatch tmp398 (quote (any any)))))) (syntax-dispatch tmp398 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp398 (quote (any any any))))) e385) (if (memv t397 (quote (define-syntax))) ((lambda (tmp423) ((lambda (tmp424) (if (if tmp424 (apply (lambda (_425 name426 val427) (id? name426)) tmp424) (quote #f)) (apply (lambda (_428 name429 val430) (values (quote define-syntax-form) name429 val430 w387 s388)) tmp424) (syntax-error tmp423))) (syntax-dispatch tmp423 (quote (any any any))))) e385) (values (quote call) (quote #f) e385 w387 s388)))))))))))))) (values (quote call) (quote #f) e385 w387 s388)))) ((syntax-object? e385) (syntax-type (syntax-object-expression e385) r386 (join-wraps w387 (syntax-object-wrap e385)) (quote #f) rib389)) ((annotation? e385) (syntax-type (annotation-expression e385) r386 w387 (annotation-source e385) rib389)) ((let ((x431 e385)) (or (boolean? x431) (number? x431) (string? x431) (char? x431) (null? x431) (keyword? x431))) (values (quote constant) (quote #f) e385 w387 s388)) (else (values (quote other) (quote #f) e385 w387 s388))))) (chi-when-list (lambda (e432 when-list433 w434) (let f435 ((when-list436 when-list433) (situations (quote ()))) (if (null? when-list436) situations (f435 (cdr when-list436) (cons (let ((x437 (car when-list436))) (cond ((free-id=? x437 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote compile)) ((free-id=? x437 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote load)) ((free-id=? x437 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote eval)) (else (syntax-error (wrap x437 w434) (quote "invalid eval-when situation"))))) situations)))))) (chi-install-global (lambda (name438 e439) (list (quote install-global-transformer) (list (quote quote) name438) e439))) (chi-top-sequence (lambda (body440 r441 w442 s443 m444 esew445) (build-sequence s443 (let dobody ((body446 body440) (r447 r441) (w448 w442) (m449 m444) (esew450 esew445)) (if (null? body446) (quote ()) (let ((first451 (chi-top (car body446) r447 w448 m449 esew450))) (cons first451 (dobody (cdr body446) r447 w448 m449 esew450)))))))) (chi-sequence (lambda (body452 r453 w454 s455) (build-sequence s455 (let dobody456 ((body457 body452) (r458 r453) (w459 w454)) (if (null? body457) (quote ()) (let ((first460 (chi (car body457) r458 w459))) (cons first460 (dobody456 (cdr body457) r458 w459)))))))) (source-wrap (lambda (x461 w462 s463) (wrap (if s463 (make-annotation x461 s463 (quote #f)) x461) w462))) (wrap (lambda (x464 w465) (cond ((and (null? (wrap-marks w465)) (null? (wrap-subst w465))) x464) ((syntax-object? x464) (make-syntax-object (syntax-object-expression x464) (join-wraps w465 (syntax-object-wrap x464)))) ((null? x464) x464) (else (make-syntax-object x464 w465))))) (bound-id-member? (lambda (x466 list) (and (not (null? list)) (or (bound-id=? x466 (car list)) (bound-id-member? x466 (cdr list)))))) (distinct-bound-ids? (lambda (ids467) (let distinct? ((ids468 ids467)) (or (null? ids468) (and (not (bound-id-member? (car ids468) (cdr ids468))) (distinct? (cdr ids468))))))) (valid-bound-ids? (lambda (ids469) (and (let all-ids? ((ids470 ids469)) (or (null? ids470) (and (id? (car ids470)) (all-ids? (cdr ids470))))) (distinct-bound-ids? ids469)))) (bound-id=? (lambda (i471 j) (if (and (syntax-object? i471) (syntax-object? j)) (and (eq? (let ((e472 (syntax-object-expression i471))) (if (annotation? e472) (annotation-expression e472) e472)) (let ((e473 (syntax-object-expression j))) (if (annotation? e473) (annotation-expression e473) e473))) (same-marks? (wrap-marks (syntax-object-wrap i471)) (wrap-marks (syntax-object-wrap j)))) (eq? (let ((e474 i471)) (if (annotation? e474) (annotation-expression e474) e474)) (let ((e475 j)) (if (annotation? e475) (annotation-expression e475) e475)))))) (free-id=? (lambda (i476 j477) (and (eq? (let ((x478 i476)) (let ((e479 (if (syntax-object? x478) (syntax-object-expression x478) x478))) (if (annotation? e479) (annotation-expression e479) e479))) (let ((x480 j477)) (let ((e481 (if (syntax-object? x480) (syntax-object-expression x480) x480))) (if (annotation? e481) (annotation-expression e481) e481)))) (eq? (id-var-name i476 (quote (()))) (id-var-name j477 (quote (()))))))) (id-var-name (lambda (id482 w483) (letrec ((search-vector-rib (lambda (sym subst marks489 symnames ribcage490) (let ((n491 (vector-length symnames))) (let f492 ((i493 (quote 0))) (cond ((fx= i493 n491) (search sym (cdr subst) marks489)) ((and (eq? (vector-ref symnames i493) sym) (same-marks? marks489 (vector-ref (ribcage-marks ribcage490) i493))) (values (vector-ref (ribcage-labels ribcage490) i493) marks489)) (else (f492 (fx+ i493 (quote 1))))))))) (search-list-rib (lambda (sym494 subst495 marks496 symnames497 ribcage498) (let f499 ((symnames500 symnames497) (i501 (quote 0))) (cond ((null? symnames500) (search sym494 (cdr subst495) marks496)) ((and (eq? (car symnames500) sym494) (same-marks? marks496 (list-ref (ribcage-marks ribcage498) i501))) (values (list-ref (ribcage-labels ribcage498) i501) marks496)) (else (f499 (cdr symnames500) (fx+ i501 (quote 1)))))))) (search (lambda (sym502 subst503 marks504) (if (null? subst503) (values (quote #f) marks504) (let ((fst (car subst503))) (if (eq? fst (quote shift)) (search sym502 (cdr subst503) (cdr marks504)) (let ((symnames505 (ribcage-symnames fst))) (if (vector? symnames505) (search-vector-rib sym502 subst503 marks504 symnames505 fst) (search-list-rib sym502 subst503 marks504 symnames505 fst))))))))) (cond ((symbol? id482) (or (call-with-values (lambda () (search id482 (wrap-subst w483) (wrap-marks w483))) (lambda (x506 . ignore) x506)) id482)) ((syntax-object? id482) (let ((id507 (let ((e508 (syntax-object-expression id482))) (if (annotation? e508) (annotation-expression e508) e508))) (w1 (syntax-object-wrap id482))) (let ((marks509 (join-marks (wrap-marks w483) (wrap-marks w1)))) (call-with-values (lambda () (search id507 (wrap-subst w483) marks509)) (lambda (new-id marks510) (or new-id (call-with-values (lambda () (search id507 (wrap-subst w1) marks510)) (lambda (x512 . ignore511) x512)) id507)))))) ((annotation? id482) (let ((id513 (let ((e514 id482)) (if (annotation? e514) (annotation-expression e514) e514)))) (or (call-with-values (lambda () (search id513 (wrap-subst w483) (wrap-marks w483))) (lambda (x516 . ignore515) x516)) id513))) (else (error-hook (quote id-var-name) (quote "invalid id") id482)))))) (same-marks? (lambda (x517 y) (or (eq? x517 y) (and (not (null? x517)) (not (null? y)) (eq? (car x517) (car y)) (same-marks? (cdr x517) (cdr y)))))) (join-marks (lambda (m1 m2) (smart-append m1 m2))) (join-wraps (lambda (w1518 w2) (let ((m1519 (wrap-marks w1518)) (s1 (wrap-subst w1518))) (if (null? m1519) (if (null? s1) w2 (make-wrap (wrap-marks w2) (smart-append s1 (wrap-subst w2)))) (make-wrap (smart-append m1519 (wrap-marks w2)) (smart-append s1 (wrap-subst w2))))))) (smart-append (lambda (m1520 m2521) (if (null? m2521) m1520 (append m1520 m2521)))) (make-binding-wrap (lambda (ids522 labels523 w524) (if (null? ids522) w524 (make-wrap (wrap-marks w524) (cons (let ((labelvec (list->vector labels523))) (let ((n525 (vector-length labelvec))) (let ((symnamevec (make-vector n525)) (marksvec (make-vector n525))) (begin (let f526 ((ids527 ids522) (i528 (quote 0))) (if (not (null? ids527)) (call-with-values (lambda () (id-sym-name&marks (car ids527) w524)) (lambda (symname marks529) (begin (vector-set! symnamevec i528 symname) (vector-set! marksvec i528 marks529) (f526 (cdr ids527) (fx+ i528 (quote 1)))))))) (make-ribcage symnamevec marksvec labelvec))))) (wrap-subst w524)))))) (extend-ribcage! (lambda (ribcage530 id531 label532) (begin (set-ribcage-symnames! ribcage530 (cons (let ((e533 (syntax-object-expression id531))) (if (annotation? e533) (annotation-expression e533) e533)) (ribcage-symnames ribcage530))) (set-ribcage-marks! ribcage530 (cons (wrap-marks (syntax-object-wrap id531)) (ribcage-marks ribcage530))) (set-ribcage-labels! ribcage530 (cons label532 (ribcage-labels ribcage530)))))) (anti-mark (lambda (w534) (make-wrap (cons (quote #f) (wrap-marks w534)) (cons (quote shift) (wrap-subst w534))))) (set-ribcage-labels! (lambda (x535 update) (vector-set! x535 (quote 3) update))) (set-ribcage-marks! (lambda (x536 update537) (vector-set! x536 (quote 2) update537))) (set-ribcage-symnames! (lambda (x538 update539) (vector-set! x538 (quote 1) update539))) (ribcage-labels (lambda (x540) (vector-ref x540 (quote 3)))) (ribcage-marks (lambda (x541) (vector-ref x541 (quote 2)))) (ribcage-symnames (lambda (x542) (vector-ref x542 (quote 1)))) (ribcage? (lambda (x543) (and (vector? x543) (= (vector-length x543) (quote 4)) (eq? (vector-ref x543 (quote 0)) (quote ribcage))))) (make-ribcage (lambda (symnames544 marks545 labels546) (vector (quote ribcage) symnames544 marks545 labels546))) (gen-labels (lambda (ls547) (if (null? ls547) (quote ()) (cons (gen-label) (gen-labels (cdr ls547)))))) (gen-label (lambda () (string (quote #\i)))) (wrap-subst cdr) (wrap-marks car) (make-wrap cons) (id-sym-name&marks (lambda (x548 w549) (if (syntax-object? x548) (values (let ((e550 (syntax-object-expression x548))) (if (annotation? e550) (annotation-expression e550) e550)) (join-marks (wrap-marks w549) (wrap-marks (syntax-object-wrap x548)))) (values (let ((e551 x548)) (if (annotation? e551) (annotation-expression e551) e551)) (wrap-marks w549))))) (id? (lambda (x552) (cond ((symbol? x552) (quote #t)) ((syntax-object? x552) (symbol? (let ((e553 (syntax-object-expression x552))) (if (annotation? e553) (annotation-expression e553) e553)))) ((annotation? x552) (symbol? (annotation-expression x552))) (else (quote #f))))) (nonsymbol-id? (lambda (x554) (and (syntax-object? x554) (symbol? (let ((e555 (syntax-object-expression x554))) (if (annotation? e555) (annotation-expression e555) e555)))))) (global-extend (lambda (type556 sym557 val558) (put-global-definition-hook sym557 (cons type556 val558)))) (lookup (lambda (x559 r560) (cond ((assq x559 r560) => cdr) ((symbol? x559) (or (get-global-definition-hook x559) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env (lambda (r561) (if (null? r561) (quote ()) (let ((a562 (car r561))) (if (eq? (cadr a562) (quote macro)) (cons a562 (macros-only-env (cdr r561))) (macros-only-env (cdr r561))))))) (extend-var-env (lambda (labels563 vars564 r565) (if (null? labels563) r565 (extend-var-env (cdr labels563) (cdr vars564) (cons (cons (car labels563) (cons (quote lexical) (car vars564))) r565))))) (extend-env (lambda (labels566 bindings567 r568) (if (null? labels566) r568 (extend-env (cdr labels566) (cdr bindings567) (cons (cons (car labels566) (car bindings567)) r568))))) (binding-value cdr) (binding-type car) (source-annotation (lambda (x569) (cond ((annotation? x569) (annotation-source x569)) ((syntax-object? x569) (source-annotation (syntax-object-expression x569))) (else (quote #f))))) (set-syntax-object-wrap! (lambda (x570 update571) (vector-set! x570 (quote 2) update571))) (set-syntax-object-expression! (lambda (x572 update573) (vector-set! x572 (quote 1) update573))) (syntax-object-wrap (lambda (x574) (vector-ref x574 (quote 2)))) (syntax-object-expression (lambda (x575) (vector-ref x575 (quote 1)))) (syntax-object? (lambda (x576) (and (vector? x576) (= (vector-length x576) (quote 3)) (eq? (vector-ref x576 (quote 0)) (quote syntax-object))))) (make-syntax-object (lambda (expression wrap577) (vector (quote syntax-object) expression wrap577))) (build-letrec (lambda (src578 vars579 val-exps body-exp) (if (null? vars579) body-exp (list (quote letrec) (map list vars579 val-exps) body-exp)))) (build-named-let (lambda (src580 vars581 val-exps582 body-exp583) (if (null? vars581) body-exp583 (list (quote let) (car vars581) (map list (cdr vars581) val-exps582) body-exp583)))) (build-let (lambda (src584 vars585 val-exps586 body-exp587) (if (null? vars585) body-exp587 (list (quote let) (map list vars585 val-exps586) body-exp587)))) (build-sequence (lambda (src588 exps) (if (null? (cdr exps)) (car exps) (cons (quote begin) exps)))) (get-global-definition-hook (lambda (symbol) (getprop symbol (quote *sc-expander*)))) (put-global-definition-hook (lambda (symbol589 binding) (putprop symbol589 (quote *sc-expander*) binding))) (error-hook (lambda (who590 why what) (error who590 (quote "~a ~s") why what))) (local-eval-hook (lambda (x591) (eval (list noexpand x591) (interaction-environment)))) (top-level-eval-hook (lambda (x592) (eval (list noexpand x592) (interaction-environment)))) (annotation? (lambda (x593) (quote #f))) (fx< <) (fx= =) (fx- -) (fx+ +) (noexpand (quote "noexpand"))) (begin (global-extend (quote local-syntax) (quote letrec-syntax) (quote #t)) (global-extend (quote local-syntax) (quote let-syntax) (quote #f)) (global-extend (quote core) (quote fluid-let-syntax) (lambda (e594 r595 w596 s597) ((lambda (tmp598) ((lambda (tmp599) (if (if tmp599 (apply (lambda (_600 var601 val602 e1603 e2604) (valid-bound-ids? var601)) tmp599) (quote #f)) (apply (lambda (_606 var607 val608 e1609 e2610) (let ((names (map (lambda (x611) (id-var-name x611 w596)) var607))) (begin (for-each (lambda (id613 n614) (let ((t615 (binding-type (lookup n614 r595)))) (if (memv t615 (quote (displaced-lexical))) (syntax-error (source-wrap id613 w596 s597) (quote "identifier out of context"))))) var607 names) (chi-body (cons e1609 e2610) (source-wrap e594 w596 s597) (extend-env names (let ((trans-r618 (macros-only-env r595))) (map (lambda (x619) (cons (quote macro) (eval-local-transformer (chi x619 trans-r618 w596)))) val608)) r595) w596)))) tmp599) ((lambda (_621) (syntax-error (source-wrap e594 w596 s597))) tmp598))) (syntax-dispatch tmp598 (quote (any #(each (any any)) any . each-any))))) e594))) (global-extend (quote core) (quote quote) (lambda (e622 r623 w624 s625) ((lambda (tmp626) ((lambda (tmp627) (if tmp627 (apply (lambda (_628 e629) (list (quote quote) (strip e629 w624))) tmp627) ((lambda (_630) (syntax-error (source-wrap e622 w624 s625))) tmp626))) (syntax-dispatch tmp626 (quote (any any))))) e622))) (global-extend (quote core) (quote syntax) (letrec ((regen (lambda (x631) (let ((t632 (car x631))) (if (memv t632 (quote (ref))) (cadr x631) (if (memv t632 (quote (primitive))) (cadr x631) (if (memv t632 (quote (quote))) (list (quote quote) (cadr x631)) (if (memv t632 (quote (lambda))) (list (quote lambda) (cadr x631) (regen (caddr x631))) (if (memv t632 (quote (map))) (let ((ls633 (map regen (cdr x631)))) (cons (if (fx= (length ls633) (quote 2)) (quote map) (quote map)) ls633)) (cons (car x631) (map regen (cdr x631))))))))))) (gen-vector (lambda (x634) (cond ((eq? (car x634) (quote list)) (cons (quote vector) (cdr x634))) ((eq? (car x634) (quote quote)) (list (quote quote) (list->vector (cadr x634)))) (else (list (quote list->vector) x634))))) (gen-append (lambda (x635 y636) (if (equal? y636 (quote (quote ()))) x635 (list (quote append) x635 y636)))) (gen-cons (lambda (x637 y638) (let ((t639 (car y638))) (if (memv t639 (quote (quote))) (if (eq? (car x637) (quote quote)) (list (quote quote) (cons (cadr x637) (cadr y638))) (if (eq? (cadr y638) (quote ())) (list (quote list) x637) (list (quote cons) x637 y638))) (if (memv t639 (quote (list))) (cons (quote list) (cons x637 (cdr y638))) (list (quote cons) x637 y638)))))) (gen-map (lambda (e640 map-env) (let ((formals (map cdr map-env)) (actuals (map (lambda (x641) (list (quote ref) (car x641))) map-env))) (cond ((eq? (car e640) (quote ref)) (car actuals)) ((andmap (lambda (x642) (and (eq? (car x642) (quote ref)) (memq (cadr x642) formals))) (cdr e640)) (cons (quote map) (cons (list (quote primitive) (car e640)) (map (let ((r643 (map cons formals actuals))) (lambda (x644) (cdr (assq (cadr x644) r643)))) (cdr e640))))) (else (cons (quote map) (cons (list (quote lambda) formals e640) actuals))))))) (gen-mappend (lambda (e645 map-env646) (list (quote apply) (quote (primitive append)) (gen-map e645 map-env646)))) (gen-ref (lambda (src647 var648 level649 maps) (if (fx= level649 (quote 0)) (values var648 maps) (if (null? maps) (syntax-error src647 (quote "missing ellipsis in syntax form")) (call-with-values (lambda () (gen-ref src647 var648 (fx- level649 (quote 1)) (cdr maps))) (lambda (outer-var outer-maps) (let ((b650 (assq outer-var (car maps)))) (if b650 (values (cdr b650) maps) (let ((inner-var (gen-var (quote tmp)))) (values inner-var (cons (cons (cons outer-var inner-var) (car maps)) outer-maps))))))))))) (gen-syntax (lambda (src651 e652 r653 maps654 ellipsis?655) (if (id? e652) (let ((label656 (id-var-name e652 (quote (()))))) (let ((b657 (lookup label656 r653))) (if (eq? (binding-type b657) (quote syntax)) (call-with-values (lambda () (let ((var.lev (binding-value b657))) (gen-ref src651 (car var.lev) (cdr var.lev) maps654))) (lambda (var658 maps659) (values (list (quote ref) var658) maps659))) (if (ellipsis?655 e652) (syntax-error src651 (quote "misplaced ellipsis in syntax form")) (values (list (quote quote) e652) maps654))))) ((lambda (tmp660) ((lambda (tmp661) (if (if tmp661 (apply (lambda (dots e662) (ellipsis?655 dots)) tmp661) (quote #f)) (apply (lambda (dots663 e664) (gen-syntax src651 e664 r653 maps654 (lambda (x665) (quote #f)))) tmp661) ((lambda (tmp666) (if (if tmp666 (apply (lambda (x667 dots668 y669) (ellipsis?655 dots668)) tmp666) (quote #f)) (apply (lambda (x670 dots671 y672) (let f673 ((y674 y672) (k675 (lambda (maps676) (call-with-values (lambda () (gen-syntax src651 x670 r653 (cons (quote ()) maps676) ellipsis?655)) (lambda (x677 maps678) (if (null? (car maps678)) (syntax-error src651 (quote "extra ellipsis in syntax form")) (values (gen-map x677 (car maps678)) (cdr maps678)))))))) ((lambda (tmp679) ((lambda (tmp680) (if (if tmp680 (apply (lambda (dots681 y682) (ellipsis?655 dots681)) tmp680) (quote #f)) (apply (lambda (dots683 y684) (f673 y684 (lambda (maps685) (call-with-values (lambda () (k675 (cons (quote ()) maps685))) (lambda (x686 maps687) (if (null? (car maps687)) (syntax-error src651 (quote "extra ellipsis in syntax form")) (values (gen-mappend x686 (car maps687)) (cdr maps687)))))))) tmp680) ((lambda (_688) (call-with-values (lambda () (gen-syntax src651 y674 r653 maps654 ellipsis?655)) (lambda (y689 maps690) (call-with-values (lambda () (k675 maps690)) (lambda (x691 maps692) (values (gen-append x691 y689) maps692)))))) tmp679))) (syntax-dispatch tmp679 (quote (any . any))))) y674))) tmp666) ((lambda (tmp693) (if tmp693 (apply (lambda (x694 y695) (call-with-values (lambda () (gen-syntax src651 x694 r653 maps654 ellipsis?655)) (lambda (x696 maps697) (call-with-values (lambda () (gen-syntax src651 y695 r653 maps697 ellipsis?655)) (lambda (y698 maps699) (values (gen-cons x696 y698) maps699)))))) tmp693) ((lambda (tmp700) (if tmp700 (apply (lambda (e1701 e2702) (call-with-values (lambda () (gen-syntax src651 (cons e1701 e2702) r653 maps654 ellipsis?655)) (lambda (e704 maps705) (values (gen-vector e704) maps705)))) tmp700) ((lambda (_706) (values (list (quote quote) e652) maps654)) tmp660))) (syntax-dispatch tmp660 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp660 (quote (any . any)))))) (syntax-dispatch tmp660 (quote (any any . any)))))) (syntax-dispatch tmp660 (quote (any any))))) e652))))) (lambda (e707 r708 w709 s710) (let ((e711 (source-wrap e707 w709 s710))) ((lambda (tmp712) ((lambda (tmp713) (if tmp713 (apply (lambda (_714 x715) (call-with-values (lambda () (gen-syntax e711 x715 r708 (quote ()) ellipsis?)) (lambda (e716 maps717) (regen e716)))) tmp713) ((lambda (_718) (syntax-error e711)) tmp712))) (syntax-dispatch tmp712 (quote (any any))))) e711))))) (global-extend (quote core) (quote lambda) (lambda (e719 r720 w721 s722) ((lambda (tmp723) ((lambda (tmp724) (if tmp724 (apply (lambda (_725 c726) (chi-lambda-clause (source-wrap e719 w721 s722) c726 r720 w721 (lambda (vars727 body728) (list (quote lambda) vars727 body728)))) tmp724) (syntax-error tmp723))) (syntax-dispatch tmp723 (quote (any . any))))) e719))) (global-extend (quote core) (quote let) (letrec ((chi-let (lambda (e729 r730 w731 s732 constructor733 ids734 vals735 exps736) (if (not (valid-bound-ids? ids734)) (syntax-error e729 (quote "duplicate bound variable in")) (let ((labels737 (gen-labels ids734)) (new-vars738 (map gen-var ids734))) (let ((nw (make-binding-wrap ids734 labels737 w731)) (nr (extend-var-env labels737 new-vars738 r730))) (constructor733 s732 new-vars738 (map (lambda (x739) (chi x739 r730 w731)) vals735) (chi-body exps736 (source-wrap e729 nw s732) nr nw)))))))) (lambda (e740 r741 w742 s743) ((lambda (tmp744) ((lambda (tmp745) (if tmp745 (apply (lambda (_746 id747 val748 e1749 e2750) (chi-let e740 r741 w742 s743 build-let id747 val748 (cons e1749 e2750))) tmp745) ((lambda (tmp754) (if (if tmp754 (apply (lambda (_755 f756 id757 val758 e1759 e2760) (id? f756)) tmp754) (quote #f)) (apply (lambda (_761 f762 id763 val764 e1765 e2766) (chi-let e740 r741 w742 s743 build-named-let (cons f762 id763) val764 (cons e1765 e2766))) tmp754) ((lambda (_770) (syntax-error (source-wrap e740 w742 s743))) tmp744))) (syntax-dispatch tmp744 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp744 (quote (any #(each (any any)) any . each-any))))) e740)))) (global-extend (quote core) (quote letrec) (lambda (e771 r772 w773 s774) ((lambda (tmp775) ((lambda (tmp776) (if tmp776 (apply (lambda (_777 id778 val779 e1780 e2781) (let ((ids782 id778)) (if (not (valid-bound-ids? ids782)) (syntax-error e771 (quote "duplicate bound variable in")) (let ((labels784 (gen-labels ids782)) (new-vars785 (map gen-var ids782))) (let ((w786 (make-binding-wrap ids782 labels784 w773)) (r787 (extend-var-env labels784 new-vars785 r772))) (build-letrec s774 new-vars785 (map (lambda (x788) (chi x788 r787 w786)) val779) (chi-body (cons e1780 e2781) (source-wrap e771 w786 s774) r787 w786))))))) tmp776) ((lambda (_791) (syntax-error (source-wrap e771 w773 s774))) tmp775))) (syntax-dispatch tmp775 (quote (any #(each (any any)) any . each-any))))) e771))) (global-extend (quote core) (quote set!) (lambda (e792 r793 w794 s795) ((lambda (tmp796) ((lambda (tmp797) (if (if tmp797 (apply (lambda (_798 id799 val800) (id? id799)) tmp797) (quote #f)) (apply (lambda (_801 id802 val803) (let ((val804 (chi val803 r793 w794)) (n805 (id-var-name id802 w794))) (let ((b806 (lookup n805 r793))) (let ((t807 (binding-type b806))) (if (memv t807 (quote (lexical))) (list (quote set!) (binding-value b806) val804) (if (memv t807 (quote (global))) (list (quote set!) n805 val804) (if (memv t807 (quote (displaced-lexical))) (syntax-error (wrap id802 w794) (quote "identifier out of context")) (syntax-error (source-wrap e792 w794 s795))))))))) tmp797) ((lambda (tmp808) (if tmp808 (apply (lambda (_809 getter arg val810) (cons (chi (list (quote #(syntax-object setter ((top) #(ribcage #(_ getter arg val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) getter) r793 w794) (map (lambda (e811) (chi e811 r793 w794)) (append arg (list val810))))) tmp808) ((lambda (_813) (syntax-error (source-wrap e792 w794 s795))) tmp796))) (syntax-dispatch tmp796 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp796 (quote (any any any))))) e792))) (global-extend (quote begin) (quote begin) (quote ())) (global-extend (quote define) (quote define) (quote ())) (global-extend (quote define-syntax) (quote define-syntax) (quote ())) (global-extend (quote eval-when) (quote eval-when) (quote ())) (global-extend (quote core) (quote syntax-case) (letrec ((gen-syntax-case (lambda (x814 keys clauses r815) (if (null? clauses) (list (quote syntax-error) x814) ((lambda (tmp816) ((lambda (tmp817) (if tmp817 (apply (lambda (pat exp818) (if (and (id? pat) (andmap (lambda (x819) (not (free-id=? pat x819))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) keys))) (let ((labels820 (list (gen-label))) (var821 (gen-var pat))) (list (list (quote lambda) (list var821) (chi exp818 (extend-env labels820 (list (cons (quote syntax) (cons var821 (quote 0)))) r815) (make-binding-wrap (list pat) labels820 (quote (()))))) x814)) (gen-clause x814 keys (cdr clauses) r815 pat (quote #t) exp818))) tmp817) ((lambda (tmp822) (if tmp822 (apply (lambda (pat823 fender exp824) (gen-clause x814 keys (cdr clauses) r815 pat823 fender exp824)) tmp822) ((lambda (_825) (syntax-error (car clauses) (quote "invalid syntax-case clause"))) tmp816))) (syntax-dispatch tmp816 (quote (any any any)))))) (syntax-dispatch tmp816 (quote (any any))))) (car clauses))))) (gen-clause (lambda (x826 keys827 clauses828 r829 pat830 fender831 exp832) (call-with-values (lambda () (convert-pattern pat830 keys827)) (lambda (p833 pvars) (cond ((not (distinct-bound-ids? (map car pvars))) (syntax-error pat830 (quote "duplicate pattern variable in syntax-case pattern"))) ((not (andmap (lambda (x834) (not (ellipsis? (car x834)))) pvars)) (syntax-error pat830 (quote "misplaced ellipsis in syntax-case pattern"))) (else (let ((y835 (gen-var (quote tmp)))) (list (list (quote lambda) (list y835) (let ((y836 y835)) (list (quote if) ((lambda (tmp837) ((lambda (tmp838) (if tmp838 (apply (lambda () y836) tmp838) ((lambda (_839) (list (quote if) y836 (build-dispatch-call pvars fender831 y836 r829) (list (quote quote) (quote #f)))) tmp837))) (syntax-dispatch tmp837 (quote #(atom #t))))) fender831) (build-dispatch-call pvars exp832 y836 r829) (gen-syntax-case x826 keys827 clauses828 r829)))) (if (eq? p833 (quote any)) (list (quote list) x826) (list (quote syntax-dispatch) x826 (list (quote quote) p833))))))))))) (build-dispatch-call (lambda (pvars840 exp841 y842 r843) (let ((ids844 (map car pvars840)) (levels (map cdr pvars840))) (let ((labels845 (gen-labels ids844)) (new-vars846 (map gen-var ids844))) (list (quote apply) (list (quote lambda) new-vars846 (chi exp841 (extend-env labels845 (map (lambda (var847 level848) (cons (quote syntax) (cons var847 level848))) new-vars846 (map cdr pvars840)) r843) (make-binding-wrap ids844 labels845 (quote (()))))) y842))))) (convert-pattern (lambda (pattern keys849) (let cvt ((p850 pattern) (n851 (quote 0)) (ids852 (quote ()))) (if (id? p850) (if (bound-id-member? p850 keys849) (values (vector (quote free-id) p850) ids852) (values (quote any) (cons (cons p850 n851) ids852))) ((lambda (tmp853) ((lambda (tmp854) (if (if tmp854 (apply (lambda (x855 dots856) (ellipsis? dots856)) tmp854) (quote #f)) (apply (lambda (x857 dots858) (call-with-values (lambda () (cvt x857 (fx+ n851 (quote 1)) ids852)) (lambda (p859 ids860) (values (if (eq? p859 (quote any)) (quote each-any) (vector (quote each) p859)) ids860)))) tmp854) ((lambda (tmp861) (if tmp861 (apply (lambda (x862 y863) (call-with-values (lambda () (cvt y863 n851 ids852)) (lambda (y864 ids865) (call-with-values (lambda () (cvt x862 n851 ids865)) (lambda (x866 ids867) (values (cons x866 y864) ids867)))))) tmp861) ((lambda (tmp868) (if tmp868 (apply (lambda () (values (quote ()) ids852)) tmp868) ((lambda (tmp869) (if tmp869 (apply (lambda (x870) (call-with-values (lambda () (cvt x870 n851 ids852)) (lambda (p872 ids873) (values (vector (quote vector) p872) ids873)))) tmp869) ((lambda (x874) (values (vector (quote atom) (strip p850 (quote (())))) ids852)) tmp853))) (syntax-dispatch tmp853 (quote #(vector each-any)))))) (syntax-dispatch tmp853 (quote ()))))) (syntax-dispatch tmp853 (quote (any . any)))))) (syntax-dispatch tmp853 (quote (any any))))) p850)))))) (lambda (e875 r876 w877 s878) (let ((e879 (source-wrap e875 w877 s878))) ((lambda (tmp880) ((lambda (tmp881) (if tmp881 (apply (lambda (_882 val883 key m884) (if (andmap (lambda (x885) (and (id? x885) (not (ellipsis? x885)))) key) (let ((x887 (gen-var (quote tmp)))) (list (list (quote lambda) (list x887) (gen-syntax-case x887 key m884 r876)) (chi val883 r876 (quote (()))))) (syntax-error e879 (quote "invalid literals list in")))) tmp881) (syntax-error tmp880))) (syntax-dispatch tmp880 (quote (any any each-any . each-any))))) e879))))) (set! sc-expand (let ((m890 (quote e)) (esew891 (quote (eval)))) (lambda (x892) (if (and (pair? x892) (equal? (car x892) noexpand)) (cadr x892) (chi-top x892 (quote ()) (quote ((top))) m890 esew891))))) (set! sc-expand3 (let ((m893 (quote e)) (esew894 (quote (eval)))) (lambda (x895 . rest) (if (and (pair? x895) (equal? (car x895) noexpand)) (cadr x895) (chi-top x895 (quote ()) (quote ((top))) (if (null? rest) m893 (car rest)) (if (or (null? rest) (null? (cdr rest))) esew894 (cadr rest))))))) (set! identifier? (lambda (x896) (nonsymbol-id? x896))) (set! datum->syntax-object (lambda (id897 datum) (begin (let ((x898 id897)) (if (not (nonsymbol-id? x898)) (error-hook (quote datum->syntax-object) (quote "invalid argument") x898))) (make-syntax-object datum (syntax-object-wrap id897))))) (set! syntax-object->datum (lambda (x899) (strip x899 (quote (()))))) (set! generate-temporaries (lambda (ls900) (begin (let ((x901 ls900)) (if (not (list? x901)) (error-hook (quote generate-temporaries) (quote "invalid argument") x901))) (map (lambda (x902) (wrap (gensym) (quote ((top))))) ls900)))) (set! free-identifier=? (lambda (x903 y904) (begin (let ((x905 x903)) (if (not (nonsymbol-id? x905)) (error-hook (quote free-identifier=?) (quote "invalid argument") x905))) (let ((x906 y904)) (if (not (nonsymbol-id? x906)) (error-hook (quote free-identifier=?) (quote "invalid argument") x906))) (free-id=? x903 y904)))) (set! bound-identifier=? (lambda (x907 y908) (begin (let ((x909 x907)) (if (not (nonsymbol-id? x909)) (error-hook (quote bound-identifier=?) (quote "invalid argument") x909))) (let ((x910 y908)) (if (not (nonsymbol-id? x910)) (error-hook (quote bound-identifier=?) (quote "invalid argument") x910))) (bound-id=? x907 y908)))) (set! syntax-error (lambda (object . messages) (begin (for-each (lambda (x911) (let ((x912 x911)) (if (not (string? x912)) (error-hook (quote syntax-error) (quote "invalid argument") x912)))) messages) (let ((message (if (null? messages) (quote "invalid syntax") (apply string-append messages)))) (error-hook (quote #f) message (strip object (quote (())))))))) (set! install-global-transformer (lambda (sym913 v914) (begin (let ((x915 sym913)) (if (not (symbol? x915)) (error-hook (quote define-syntax) (quote "invalid argument") x915))) (let ((x916 v914)) (if (not (procedure? x916)) (error-hook (quote define-syntax) (quote "invalid argument") x916))) (global-extend (quote macro) sym913 v914)))) (letrec ((match (lambda (e917 p918 w919 r920) (cond ((not r920) (quote #f)) ((eq? p918 (quote any)) (cons (wrap e917 w919) r920)) ((syntax-object? e917) (match* (let ((e921 (syntax-object-expression e917))) (if (annotation? e921) (annotation-expression e921) e921)) p918 (join-wraps w919 (syntax-object-wrap e917)) r920)) (else (match* (let ((e922 e917)) (if (annotation? e922) (annotation-expression e922) e922)) p918 w919 r920))))) (match* (lambda (e923 p924 w925 r926) (cond ((null? p924) (and (null? e923) r926)) ((pair? p924) (and (pair? e923) (match (car e923) (car p924) w925 (match (cdr e923) (cdr p924) w925 r926)))) ((eq? p924 (quote each-any)) (let ((l (match-each-any e923 w925))) (and l (cons l r926)))) (else (let ((t927 (vector-ref p924 (quote 0)))) (if (memv t927 (quote (each))) (if (null? e923) (match-empty (vector-ref p924 (quote 1)) r926) (let ((l928 (match-each e923 (vector-ref p924 (quote 1)) w925))) (and l928 (let collect ((l929 l928)) (if (null? (car l929)) r926 (cons (map car l929) (collect (map cdr l929)))))))) (if (memv t927 (quote (free-id))) (and (id? e923) (free-id=? (wrap e923 w925) (vector-ref p924 (quote 1))) r926) (if (memv t927 (quote (atom))) (and (equal? (vector-ref p924 (quote 1)) (strip e923 w925)) r926) (if (memv t927 (quote (vector))) (and (vector? e923) (match (vector->list e923) (vector-ref p924 (quote 1)) w925 r926))))))))))) (match-empty (lambda (p930 r931) (cond ((null? p930) r931) ((eq? p930 (quote any)) (cons (quote ()) r931)) ((pair? p930) (match-empty (car p930) (match-empty (cdr p930) r931))) ((eq? p930 (quote each-any)) (cons (quote ()) r931)) (else (let ((t932 (vector-ref p930 (quote 0)))) (if (memv t932 (quote (each))) (match-empty (vector-ref p930 (quote 1)) r931) (if (memv t932 (quote (free-id atom))) r931 (if (memv t932 (quote (vector))) (match-empty (vector-ref p930 (quote 1)) r931))))))))) (match-each-any (lambda (e933 w934) (cond ((annotation? e933) (match-each-any (annotation-expression e933) w934)) ((pair? e933) (let ((l935 (match-each-any (cdr e933) w934))) (and l935 (cons (wrap (car e933) w934) l935)))) ((null? e933) (quote ())) ((syntax-object? e933) (match-each-any (syntax-object-expression e933) (join-wraps w934 (syntax-object-wrap e933)))) (else (quote #f))))) (match-each (lambda (e936 p937 w938) (cond ((annotation? e936) (match-each (annotation-expression e936) p937 w938)) ((pair? e936) (let ((first939 (match (car e936) p937 w938 (quote ())))) (and first939 (let ((rest940 (match-each (cdr e936) p937 w938))) (and rest940 (cons first939 rest940)))))) ((null? e936) (quote ())) ((syntax-object? e936) (match-each (syntax-object-expression e936) p937 (join-wraps w938 (syntax-object-wrap e936)))) (else (quote #f)))))) (set! syntax-dispatch (lambda (e941 p942) (cond ((eq? p942 (quote any)) (list e941)) ((syntax-object? e941) (match* (let ((e943 (syntax-object-expression e941))) (if (annotation? e943) (annotation-expression e943) e943)) p942 (syntax-object-wrap e941) (quote ()))) (else (match* (let ((e944 e941)) (if (annotation? e944) (annotation-expression e944) e944)) p942 (quote (())) (quote ()))))))))) -(install-global-transformer (quote with-syntax) (lambda (x945) ((lambda (tmp946) ((lambda (tmp947) (if tmp947 (apply (lambda (_948 e1949 e2950) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1949 e2950))) tmp947) ((lambda (tmp952) (if tmp952 (apply (lambda (_953 out in e1954 e2955) (list (quote #(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"))))) in (quote ()) (list out (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1954 e2955))))) tmp952) ((lambda (tmp957) (if tmp957 (apply (lambda (_958 out959 in960 e1961 e2962) (list (quote #(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"))))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) in960) (quote ()) (list out959 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1961 e2962))))) tmp957) (syntax-error tmp946))) (syntax-dispatch tmp946 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp946 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp946 (quote (any () any . each-any))))) x945))) -(install-global-transformer (quote syntax-rules) (lambda (x966) ((lambda (tmp967) ((lambda (tmp968) (if tmp968 (apply (lambda (_969 k970 keyword pattern971 template) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons k970 (map (lambda (tmp973 tmp972) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) tmp972) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) tmp973))) template pattern971)))))) tmp968) (syntax-error tmp967))) (syntax-dispatch tmp967 (quote (any each-any . #(each ((any . any) any))))))) x966))) -(install-global-transformer (quote let*) (lambda (x) ((lambda (tmp974) ((lambda (tmp975) (if (if tmp975 (apply (lambda (let* x976 v e1 e2) (andmap identifier? x976)) tmp975) (quote #f)) (apply (lambda (let*978 x979 v980 e1981 e2982) (let f ((bindings (map list x979 v980))) (if (null? bindings) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote ()) (cons e1981 e2982))) ((lambda (tmp986) ((lambda (tmp987) (if tmp987 (apply (lambda (body binding) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list binding) body)) tmp987) (syntax-error tmp986))) (syntax-dispatch tmp986 (quote (any any))))) (list (f (cdr bindings)) (car bindings)))))) tmp975) (syntax-error tmp974))) (syntax-dispatch tmp974 (quote (any #(each (any any)) any . each-any))))) x))) -(install-global-transformer (quote do) (lambda (orig-x) ((lambda (tmp988) ((lambda (tmp989) (if tmp989 (apply (lambda (_ var init step e0 e1990 c) ((lambda (tmp991) ((lambda (tmp992) (if tmp992 (apply (lambda (step993) ((lambda (tmp994) ((lambda (tmp995) (if tmp995 (apply (lambda () (list (quote #(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"))))) (quote #(syntax-object doloop ((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"))))) (map list var init) (list (quote #(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"))))) (list (quote #(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"))))) e0) (cons (quote #(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"))))) (append c (list (cons (quote #(syntax-object doloop ((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"))))) step993))))))) tmp995) ((lambda (tmp1000) (if tmp1000 (apply (lambda (e11001 e21002) (list (quote #(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"))))) (quote #(syntax-object doloop ((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"))))) (map list var init) (list (quote #(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"))))) e0 (cons (quote #(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"))))) (cons e11001 e21002)) (cons (quote #(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"))))) (append c (list (cons (quote #(syntax-object doloop ((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"))))) step993))))))) tmp1000) (syntax-error tmp994))) (syntax-dispatch tmp994 (quote (any . each-any)))))) (syntax-dispatch tmp994 (quote ())))) e1990)) tmp992) (syntax-error tmp991))) (syntax-dispatch tmp991 (quote each-any)))) (map (lambda (v1009 s) ((lambda (tmp1010) ((lambda (tmp1011) (if tmp1011 (apply (lambda () v1009) tmp1011) ((lambda (tmp1012) (if tmp1012 (apply (lambda (e) e) tmp1012) ((lambda (_1013) (syntax-error orig-x)) tmp1010))) (syntax-dispatch tmp1010 (quote (any)))))) (syntax-dispatch tmp1010 (quote ())))) s)) var step))) tmp989) (syntax-error tmp988))) (syntax-dispatch tmp988 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x))) -(install-global-transformer (quote quasiquote) (letrec ((quasicons (lambda (x1015 y) ((lambda (tmp1016) ((lambda (tmp1017) (if tmp1017 (apply (lambda (x1018 y1019) ((lambda (tmp1020) ((lambda (tmp1021) (if tmp1021 (apply (lambda (dy) ((lambda (tmp1022) ((lambda (tmp1023) (if tmp1023 (apply (lambda (dx) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons dx dy))) tmp1023) ((lambda (_1024) (if (null? dy) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1018) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1018 y1019))) tmp1022))) (syntax-dispatch tmp1022 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) x1018)) tmp1021) ((lambda (tmp1025) (if tmp1025 (apply (lambda (stuff) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons x1018 stuff))) tmp1025) ((lambda (else) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1018 y1019)) tmp1020))) (syntax-dispatch tmp1020 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . any)))))) (syntax-dispatch tmp1020 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) y1019)) tmp1017) (syntax-error tmp1016))) (syntax-dispatch tmp1016 (quote (any any))))) (list x1015 y)))) (quasiappend (lambda (x1026 y1027) ((lambda (tmp1028) ((lambda (tmp1029) (if tmp1029 (apply (lambda (x1030 y1031) ((lambda (tmp1032) ((lambda (tmp1033) (if tmp1033 (apply (lambda () x1030) tmp1033) ((lambda (_1034) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1030 y1031)) tmp1032))) (syntax-dispatch tmp1032 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) ()))))) y1031)) tmp1029) (syntax-error tmp1028))) (syntax-dispatch tmp1028 (quote (any any))))) (list x1026 y1027)))) (quasivector (lambda (x1035) ((lambda (tmp1036) ((lambda (x1037) ((lambda (tmp1038) ((lambda (tmp1039) (if tmp1039 (apply (lambda (x1040) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (list->vector x1040))) tmp1039) ((lambda (tmp1042) (if tmp1042 (apply (lambda (x1043) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1043)) tmp1042) ((lambda (_1045) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1037)) tmp1038))) (syntax-dispatch tmp1038 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . each-any)))))) (syntax-dispatch tmp1038 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) each-any))))) x1037)) tmp1036)) x1035))) (quasi (lambda (p lev) ((lambda (tmp1046) ((lambda (tmp1047) (if tmp1047 (apply (lambda (p1048) (if (= lev (quote 0)) p1048 (quasicons (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi (list p1048) (- lev (quote 1)))))) tmp1047) ((lambda (tmp1049) (if tmp1049 (apply (lambda (p1050 q) (if (= lev (quote 0)) (quasiappend p1050 (quasi q lev)) (quasicons (quasicons (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi (list p1050) (- lev (quote 1)))) (quasi q lev)))) tmp1049) ((lambda (tmp) (if tmp (apply (lambda (p1051) (quasicons (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi (list p1051) (+ lev (quote 1))))) tmp) ((lambda (tmp1052) (if tmp1052 (apply (lambda (p1053 q1054) (quasicons (quasi p1053 lev) (quasi q1054 lev))) tmp1052) ((lambda (tmp1055) (if tmp1055 (apply (lambda (x1056) (quasivector (quasi x1056 lev))) tmp1055) ((lambda (p1058) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) p1058)) tmp1046))) (syntax-dispatch tmp1046 (quote #(vector each-any)))))) (syntax-dispatch tmp1046 (quote (any . any)))))) (syntax-dispatch tmp1046 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any)))))) (syntax-dispatch tmp1046 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any) . any)))))) (syntax-dispatch tmp1046 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) p)))) (lambda (x1059) ((lambda (tmp1060) ((lambda (tmp1061) (if tmp1061 (apply (lambda (_1062 e1063) (quasi e1063 (quote 0))) tmp1061) (syntax-error tmp1060))) (syntax-dispatch tmp1060 (quote (any any))))) x1059)))) -(install-global-transformer (quote include) (lambda (x1064) (letrec ((read-file (lambda (fn k) (let ((p1065 (open-input-file fn))) (let f1066 ((x1067 (read p1065))) (if (eof-object? x1067) (begin (close-input-port p1065) (quote ())) (cons (datum->syntax-object k x1067) (f1066 (read p1065))))))))) ((lambda (tmp1068) ((lambda (tmp1069) (if tmp1069 (apply (lambda (k1070 filename) (let ((fn1071 (syntax-object->datum filename))) ((lambda (tmp1072) ((lambda (tmp1073) (if tmp1073 (apply (lambda (exp) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))))) exp)) tmp1073) (syntax-error tmp1072))) (syntax-dispatch tmp1072 (quote each-any)))) (read-file fn1071 k1070)))) tmp1069) (syntax-error tmp1068))) (syntax-dispatch tmp1068 (quote (any any))))) x1064)))) -(install-global-transformer (quote unquote) (lambda (x1075) ((lambda (tmp1076) ((lambda (tmp1077) (if tmp1077 (apply (lambda (_1078 e1079) (error (quote unquote) (quote "expression ,~s not valid outside of quasiquote") (syntax-object->datum e1079))) tmp1077) (syntax-error tmp1076))) (syntax-dispatch tmp1076 (quote (any any))))) x1075))) -(install-global-transformer (quote unquote-splicing) (lambda (x1080) ((lambda (tmp1081) ((lambda (tmp1082) (if tmp1082 (apply (lambda (_1083 e1084) (error (quote unquote-splicing) (quote "expression ,@~s not valid outside of quasiquote") (syntax-object->datum e1084))) tmp1082) (syntax-error tmp1081))) (syntax-dispatch tmp1081 (quote (any any))))) x1080))) -(install-global-transformer (quote case) (lambda (x1085) ((lambda (tmp1086) ((lambda (tmp1087) (if tmp1087 (apply (lambda (_1088 e1089 m1 m2) ((lambda (tmp1090) ((lambda (body1091) (list (quote #(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"))))) (list (list (quote #(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"))))) e1089)) body1091)) tmp1090)) (let f1092 ((clause m1) (clauses m2)) (if (null? clauses) ((lambda (tmp1094) ((lambda (tmp1095) (if tmp1095 (apply (lambda (e11096 e21097) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11096 e21097))) tmp1095) ((lambda (tmp1099) (if tmp1099 (apply (lambda (k1100 e11101 e21102) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) k1100)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11101 e21102)))) tmp1099) ((lambda (_1105) (syntax-error x1085)) tmp1094))) (syntax-dispatch tmp1094 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1094 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) any . each-any))))) clause) ((lambda (tmp1106) ((lambda (rest) ((lambda (tmp1107) ((lambda (tmp1108) (if tmp1108 (apply (lambda (k1109 e11110 e21111) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) k1109)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11110 e21111)) rest)) tmp1108) ((lambda (_1114) (syntax-error x1085)) tmp1107))) (syntax-dispatch tmp1107 (quote (each-any any . each-any))))) clause)) tmp1106)) (f1092 (car clauses) (cdr clauses))))))) tmp1087) (syntax-error tmp1086))) (syntax-dispatch tmp1086 (quote (any any any . each-any))))) x1085))) -(install-global-transformer (quote identifier-syntax) (lambda (x1115) ((lambda (tmp1116) ((lambda (tmp1117) (if tmp1117 (apply (lambda (_1118 e1119) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) e1119)) (list (cons _1118 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1119 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))))))))) tmp1117) (syntax-error tmp1116))) (syntax-dispatch tmp1116 (quote (any any))))) x1115))) +(letrec ((lambda-var-list116 (lambda (vars323) (let lvl324 ((vars325 vars323) (ls326 (quote ())) (w327 (quote (())))) (cond ((pair? vars325) (lvl324 (cdr vars325) (cons (wrap95 (car vars325) w327) ls326) w327)) ((id?67 vars325) (cons (wrap95 vars325 w327) ls326)) ((null? vars325) ls326) ((syntax-object?53 vars325) (lvl324 (syntax-object-expression54 vars325) ls326 (join-wraps86 w327 (syntax-object-wrap55 vars325)))) ((annotation?42 vars325) (lvl324 (annotation-expression vars325) ls326 w327)) (else (cons vars325 ls326)))))) (gen-var115 (lambda (id328) (let ((id329 (if (syntax-object?53 id328) (syntax-object-expression54 id328) id328))) (if (annotation?42 id329) (gentemp (symbol->string (annotation-expression id329)) generated-symbols) (gentemp (symbol->string id329) generated-symbols))))) (strip114 (lambda (x330 w331) (if (memq (quote top) (wrap-marks70 w331)) (if (or (annotation?42 x330) (and (pair? x330) (annotation?42 (car x330)))) (strip-annotation113 x330 (quote #f)) x330) (let f332 ((x333 x330)) (cond ((syntax-object?53 x333) (strip114 (syntax-object-expression54 x333) (syntax-object-wrap55 x333))) ((pair? x333) (let ((a334 (f332 (car x333))) (d335 (f332 (cdr x333)))) (if (and (eq? a334 (car x333)) (eq? d335 (cdr x333))) x333 (cons a334 d335)))) ((vector? x333) (let ((old336 (vector->list x333))) (let ((new337 (map f332 old336))) (if (andmap eq? old336 new337) x333 (list->vector new337))))) (else x333)))))) (strip-annotation113 (lambda (x338 parent339) (cond ((pair? x338) (let ((new340 (cons (quote #f) (quote #f)))) (begin (when parent339 (set-annotation-stripped! parent339 new340)) (set-car! new340 (strip-annotation113 (car x338) (quote #f))) (set-cdr! new340 (strip-annotation113 (cdr x338) (quote #f))) new340))) ((annotation?42 x338) (or (annotation-stripped x338) (strip-annotation113 (annotation-expression x338) x338))) ((vector? x338) (let ((new341 (make-vector (vector-length x338)))) (begin (when parent339 (set-annotation-stripped! parent339 new341)) (let loop342 ((i343 (- (vector-length x338) (quote 1)))) (unless (fx<41 i343 (quote 0)) (vector-set! new341 i343 (strip-annotation113 (vector-ref x338 i343) (quote #f))) (loop342 (fx-39 i343 (quote 1))))) new341))) (else x338)))) (ellipsis?112 (lambda (x344) (and (nonsymbol-id?66 x344) (free-id=?90 x344 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))))))) (chi-void111 (lambda () (list (quote void)))) (eval-local-transformer110 (lambda (expanded345) (let ((p346 (local-eval-hook44 expanded345))) (if (procedure? p346) p346 (syntax-error p346 (quote "nonprocedure transfomer")))))) (chi-local-syntax109 (lambda (rec?347 e348 r349 w350 s351 k352) ((lambda (tmp353) ((lambda (tmp354) (if tmp354 (apply (lambda (_355 id356 val357 e1358 e2359) (let ((ids360 id356)) (if (not (valid-bound-ids?92 ids360)) (syntax-error e348 (quote "duplicate bound keyword in")) (let ((labels362 (gen-labels73 ids360))) (let ((new-w363 (make-binding-wrap84 ids360 labels362 w350))) (k352 (cons e1358 e2359) (extend-env61 labels362 (let ((w365 (if rec?347 new-w363 w350)) (trans-r366 (macros-only-env63 r349))) (map (lambda (x367) (cons (quote macro) (eval-local-transformer110 (chi103 x367 trans-r366 w365)))) val357)) r349) new-w363 s351)))))) tmp354) ((lambda (_369) (syntax-error (source-wrap96 e348 w350 s351))) tmp353))) (syntax-dispatch tmp353 (quote (any #(each (any any)) any . each-any))))) e348))) (chi-lambda-clause108 (lambda (e370 c371 r372 w373 k374) ((lambda (tmp375) ((lambda (tmp376) (if tmp376 (apply (lambda (id377 e1378 e2379) (let ((ids380 id377)) (if (not (valid-bound-ids?92 ids380)) (syntax-error e370 (quote "invalid parameter list in")) (let ((labels382 (gen-labels73 ids380)) (new-vars383 (map gen-var115 ids380))) (k374 new-vars383 (chi-body107 (cons e1378 e2379) e370 (extend-var-env62 labels382 new-vars383 r372) (make-binding-wrap84 ids380 labels382 w373))))))) tmp376) ((lambda (tmp385) (if tmp385 (apply (lambda (ids386 e1387 e2388) (let ((old-ids389 (lambda-var-list116 ids386))) (if (not (valid-bound-ids?92 old-ids389)) (syntax-error e370 (quote "invalid parameter list in")) (let ((labels390 (gen-labels73 old-ids389)) (new-vars391 (map gen-var115 old-ids389))) (k374 (let f392 ((ls1393 (cdr new-vars391)) (ls2394 (car new-vars391))) (if (null? ls1393) ls2394 (f392 (cdr ls1393) (cons (car ls1393) ls2394)))) (chi-body107 (cons e1387 e2388) e370 (extend-var-env62 labels390 new-vars391 r372) (make-binding-wrap84 old-ids389 labels390 w373))))))) tmp385) ((lambda (_396) (syntax-error e370)) tmp375))) (syntax-dispatch tmp375 (quote (any any . each-any)))))) (syntax-dispatch tmp375 (quote (each-any any . each-any))))) c371))) (chi-body107 (lambda (body397 outer-form398 r399 w400) (let ((r401 (cons (quote ("placeholder" placeholder)) r399))) (let ((ribcage402 (make-ribcage74 (quote ()) (quote ()) (quote ())))) (let ((w403 (make-wrap69 (wrap-marks70 w400) (cons ribcage402 (wrap-subst71 w400))))) (let parse404 ((body405 (map (lambda (x411) (cons r401 (wrap95 x411 w403))) body397)) (ids406 (quote ())) (labels407 (quote ())) (vars408 (quote ())) (vals409 (quote ())) (bindings410 (quote ()))) (if (null? body405) (syntax-error outer-form398 (quote "no expressions in body")) (let ((e412 (cdar body405)) (er413 (caar body405))) (call-with-values (lambda () (syntax-type101 e412 er413 (quote (())) (quote #f) ribcage402)) (lambda (type414 value415 e416 w417 s418) (let ((t419 type414)) (if (memv t419 (quote (define-form))) (let ((id420 (wrap95 value415 w417)) (label421 (gen-label72))) (let ((var422 (gen-var115 id420))) (begin (extend-ribcage!83 ribcage402 id420 label421) (parse404 (cdr body405) (cons id420 ids406) (cons label421 labels407) (cons var422 vars408) (cons (cons er413 (wrap95 e416 w417)) vals409) (cons (cons (quote lexical) var422) bindings410))))) (if (memv t419 (quote (define-syntax-form))) (let ((id423 (wrap95 value415 w417)) (label424 (gen-label72))) (begin (extend-ribcage!83 ribcage402 id423 label424) (parse404 (cdr body405) (cons id423 ids406) (cons label424 labels407) vars408 vals409 (cons (cons (quote macro) (cons er413 (wrap95 e416 w417))) bindings410)))) (if (memv t419 (quote (begin-form))) ((lambda (tmp425) ((lambda (tmp426) (if tmp426 (apply (lambda (_427 e1428) (parse404 (let f429 ((forms430 e1428)) (if (null? forms430) (cdr body405) (cons (cons er413 (wrap95 (car forms430) w417)) (f429 (cdr forms430))))) ids406 labels407 vars408 vals409 bindings410)) tmp426) (syntax-error tmp425))) (syntax-dispatch tmp425 (quote (any . each-any))))) e416) (if (memv t419 (quote (local-syntax-form))) (chi-local-syntax109 value415 e416 er413 w417 s418 (lambda (forms432 er433 w434 s435) (parse404 (let f436 ((forms437 forms432)) (if (null? forms437) (cdr body405) (cons (cons er433 (wrap95 (car forms437) w434)) (f436 (cdr forms437))))) ids406 labels407 vars408 vals409 bindings410))) (if (null? ids406) (build-sequence48 (quote #f) (map (lambda (x438) (chi103 (cdr x438) (car x438) (quote (())))) (cons (cons er413 (source-wrap96 e416 w417 s418)) (cdr body405)))) (begin (if (not (valid-bound-ids?92 ids406)) (syntax-error outer-form398 (quote "invalid or duplicate identifier in definition"))) (let loop439 ((bs440 bindings410) (er-cache441 (quote #f)) (r-cache442 (quote #f))) (if (not (null? bs440)) (let ((b443 (car bs440))) (if (eq? (car b443) (quote macro)) (let ((er444 (cadr b443))) (let ((r-cache445 (if (eq? er444 er-cache441) r-cache442 (macros-only-env63 er444)))) (begin (set-cdr! b443 (eval-local-transformer110 (chi103 (cddr b443) r-cache445 (quote (()))))) (loop439 (cdr bs440) er444 r-cache445)))) (loop439 (cdr bs440) er-cache441 r-cache442))))) (set-cdr! r401 (extend-env61 labels407 bindings410 (cdr r401))) (build-letrec51 (quote #f) vars408 (map (lambda (x446) (chi103 (cdr x446) (car x446) (quote (())))) vals409) (build-sequence48 (quote #f) (map (lambda (x447) (chi103 (cdr x447) (car x447) (quote (())))) (cons (cons er413 (source-wrap96 e416 w417 s418)) (cdr body405)))))))))))))))))))))) (chi-macro106 (lambda (p448 e449 r450 w451 rib452) (letrec ((rebuild-macro-output453 (lambda (x454 m455) (cond ((pair? x454) (cons (rebuild-macro-output453 (car x454) m455) (rebuild-macro-output453 (cdr x454) m455))) ((syntax-object?53 x454) (let ((w456 (syntax-object-wrap55 x454))) (let ((ms457 (wrap-marks70 w456)) (s458 (wrap-subst71 w456))) (make-syntax-object52 (syntax-object-expression54 x454) (if (and (pair? ms457) (eq? (car ms457) (quote #f))) (make-wrap69 (cdr ms457) (if rib452 (cons rib452 (cdr s458)) (cdr s458))) (make-wrap69 (cons m455 ms457) (if rib452 (cons rib452 (cons (quote shift) s458)) (cons (quote shift) s458)))))))) ((vector? x454) (let ((n459 (vector-length x454))) (let ((v460 (make-vector n459))) (let doloop461 ((i462 (quote 0))) (if (fx=40 i462 n459) v460 (begin (vector-set! v460 i462 (rebuild-macro-output453 (vector-ref x454 i462) m455)) (doloop461 (fx+38 i462 (quote 1))))))))) ((symbol? x454) (syntax-error x454 (quote "encountered raw symbol in macro output"))) (else x454))))) (rebuild-macro-output453 (p448 (wrap95 e449 (anti-mark82 w451))) (string (quote #\m)))))) (chi-application105 (lambda (x463 e464 r465 w466 s467) ((lambda (tmp468) ((lambda (tmp469) (if tmp469 (apply (lambda (e0470 e1471) (cons x463 (map (lambda (e472) (chi103 e472 r465 w466)) e1471))) tmp469) (syntax-error tmp468))) (syntax-dispatch tmp468 (quote (any . each-any))))) e464))) (chi-expr104 (lambda (type474 value475 e476 r477 w478 s479) (let ((t480 type474)) (if (memv t480 (quote (lexical))) value475 (if (memv t480 (quote (core))) (value475 e476 r477 w478 s479) (if (memv t480 (quote (lexical-call))) (chi-application105 value475 e476 r477 w478 s479) (if (memv t480 (quote (global-call))) (chi-application105 value475 e476 r477 w478 s479) (if (memv t480 (quote (constant))) (list (quote quote) (strip114 (source-wrap96 e476 w478 s479) (quote (())))) (if (memv t480 (quote (global))) value475 (if (memv t480 (quote (call))) (chi-application105 (chi103 (car e476) r477 w478) e476 r477 w478 s479) (if (memv t480 (quote (begin-form))) ((lambda (tmp481) ((lambda (tmp482) (if tmp482 (apply (lambda (_483 e1484 e2485) (chi-sequence97 (cons e1484 e2485) r477 w478 s479)) tmp482) (syntax-error tmp481))) (syntax-dispatch tmp481 (quote (any any . each-any))))) e476) (if (memv t480 (quote (local-syntax-form))) (chi-local-syntax109 value475 e476 r477 w478 s479 chi-sequence97) (if (memv t480 (quote (eval-when-form))) ((lambda (tmp487) ((lambda (tmp488) (if tmp488 (apply (lambda (_489 x490 e1491 e2492) (let ((when-list493 (chi-when-list100 e476 x490 w478))) (if (memq (quote eval) when-list493) (chi-sequence97 (cons e1491 e2492) r477 w478 s479) (chi-void111)))) tmp488) (syntax-error tmp487))) (syntax-dispatch tmp487 (quote (any each-any any . each-any))))) e476) (if (memv t480 (quote (define-form define-syntax-form))) (syntax-error (wrap95 value475 w478) (quote "invalid context for definition of")) (if (memv t480 (quote (syntax))) (syntax-error (source-wrap96 e476 w478 s479) (quote "reference to pattern variable outside syntax form")) (if (memv t480 (quote (displaced-lexical))) (syntax-error (source-wrap96 e476 w478 s479) (quote "reference to identifier outside its scope")) (syntax-error (source-wrap96 e476 w478 s479)))))))))))))))))) (chi103 (lambda (e496 r497 w498) (call-with-values (lambda () (syntax-type101 e496 r497 w498 (quote #f) (quote #f))) (lambda (type499 value500 e501 w502 s503) (chi-expr104 type499 value500 e501 r497 w502 s503))))) (chi-top102 (lambda (e504 r505 w506 m507 esew508) (call-with-values (lambda () (syntax-type101 e504 r505 w506 (quote #f) (quote #f))) (lambda (type515 value516 e517 w518 s519) (let ((t520 type515)) (if (memv t520 (quote (begin-form))) ((lambda (tmp521) ((lambda (tmp522) (if tmp522 (apply (lambda (_523) (chi-void111)) tmp522) ((lambda (tmp524) (if tmp524 (apply (lambda (_525 e1526 e2527) (chi-top-sequence98 (cons e1526 e2527) r505 w518 s519 m507 esew508)) tmp524) (syntax-error tmp521))) (syntax-dispatch tmp521 (quote (any any . each-any)))))) (syntax-dispatch tmp521 (quote (any))))) e517) (if (memv t520 (quote (local-syntax-form))) (chi-local-syntax109 value516 e517 r505 w518 s519 (lambda (body529 r530 w531 s532) (chi-top-sequence98 body529 r530 w531 s532 m507 esew508))) (if (memv t520 (quote (eval-when-form))) ((lambda (tmp533) ((lambda (tmp534) (if tmp534 (apply (lambda (_535 x536 e1537 e2538) (let ((when-list539 (chi-when-list100 e517 x536 w518)) (body540 (cons e1537 e2538))) (cond ((eq? m507 (quote e)) (if (memq (quote eval) when-list539) (chi-top-sequence98 body540 r505 w518 s519 (quote e) (quote (eval))) (chi-void111))) ((memq (quote load) when-list539) (if (or (memq (quote compile) when-list539) (and (eq? m507 (quote c&e)) (memq (quote eval) when-list539))) (chi-top-sequence98 body540 r505 w518 s519 (quote c&e) (quote (compile load))) (if (memq m507 (quote (c c&e))) (chi-top-sequence98 body540 r505 w518 s519 (quote c) (quote (load))) (chi-void111)))) ((or (memq (quote compile) when-list539) (and (eq? m507 (quote c&e)) (memq (quote eval) when-list539))) (top-level-eval-hook43 (chi-top-sequence98 body540 r505 w518 s519 (quote e) (quote (eval)))) (chi-void111)) (else (chi-void111))))) tmp534) (syntax-error tmp533))) (syntax-dispatch tmp533 (quote (any each-any any . each-any))))) e517) (if (memv t520 (quote (define-syntax-form))) (let ((n543 (id-var-name89 value516 w518)) (r544 (macros-only-env63 r505))) (let ((t545 m507)) (if (memv t545 (quote (c))) (if (memq (quote compile) esew508) (let ((e546 (chi-install-global99 n543 (chi103 e517 r544 w518)))) (begin (top-level-eval-hook43 e546) (if (memq (quote load) esew508) e546 (chi-void111)))) (if (memq (quote load) esew508) (chi-install-global99 n543 (chi103 e517 r544 w518)) (chi-void111))) (if (memv t545 (quote (c&e))) (let ((e547 (chi-install-global99 n543 (chi103 e517 r544 w518)))) (begin (top-level-eval-hook43 e547) e547)) (begin (if (memq (quote eval) esew508) (top-level-eval-hook43 (chi-install-global99 n543 (chi103 e517 r544 w518)))) (chi-void111)))))) (if (memv t520 (quote (define-form))) (let ((n548 (id-var-name89 value516 w518))) (let ((t549 (binding-type59 (lookup64 n548 r505)))) (if (memv t549 (quote (global))) (let ((x550 (list (quote define) n548 (chi103 e517 r505 w518)))) (begin (if (eq? m507 (quote c&e)) (top-level-eval-hook43 x550)) x550)) (if (memv t549 (quote (displaced-lexical))) (syntax-error (wrap95 value516 w518) (quote "identifier out of context")) (syntax-error (wrap95 value516 w518) (quote "cannot define keyword at top level")))))) (let ((x551 (chi-expr104 type515 value516 e517 r505 w518 s519))) (begin (if (eq? m507 (quote c&e)) (top-level-eval-hook43 x551)) x551)))))))))))) (syntax-type101 (lambda (e552 r553 w554 s555 rib556) (cond ((symbol? e552) (let ((n557 (id-var-name89 e552 w554))) (let ((b558 (lookup64 n557 r553))) (let ((type559 (binding-type59 b558))) (let ((t560 type559)) (if (memv t560 (quote (lexical))) (values type559 (binding-value60 b558) e552 w554 s555) (if (memv t560 (quote (global))) (values type559 n557 e552 w554 s555) (if (memv t560 (quote (macro))) (syntax-type101 (chi-macro106 (binding-value60 b558) e552 r553 w554 rib556) r553 (quote (())) s555 rib556) (values type559 (binding-value60 b558) e552 w554 s555))))))))) ((pair? e552) (let ((first561 (car e552))) (if (id?67 first561) (let ((n562 (id-var-name89 first561 w554))) (let ((b563 (lookup64 n562 r553))) (let ((type564 (binding-type59 b563))) (let ((t565 type564)) (if (memv t565 (quote (lexical))) (values (quote lexical-call) (binding-value60 b563) e552 w554 s555) (if (memv t565 (quote (global))) (values (quote global-call) n562 e552 w554 s555) (if (memv t565 (quote (macro))) (syntax-type101 (chi-macro106 (binding-value60 b563) e552 r553 w554 rib556) r553 (quote (())) s555 rib556) (if (memv t565 (quote (core))) (values type564 (binding-value60 b563) e552 w554 s555) (if (memv t565 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value60 b563) e552 w554 s555) (if (memv t565 (quote (begin))) (values (quote begin-form) (quote #f) e552 w554 s555) (if (memv t565 (quote (eval-when))) (values (quote eval-when-form) (quote #f) e552 w554 s555) (if (memv t565 (quote (define))) ((lambda (tmp566) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 val570) (id?67 name569)) tmp567) (quote #f)) (apply (lambda (_571 name572 val573) (values (quote define-form) name572 val573 w554 s555)) tmp567) ((lambda (tmp574) (if (if tmp574 (apply (lambda (_575 name576 args577 e1578 e2579) (and (id?67 name576) (valid-bound-ids?92 (lambda-var-list116 args577)))) tmp574) (quote #f)) (apply (lambda (_580 name581 args582 e1583 e2584) (values (quote define-form) (wrap95 name581 w554) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) (wrap95 (cons args582 (cons e1583 e2584)) w554)) (quote (())) s555)) tmp574) ((lambda (tmp586) (if (if tmp586 (apply (lambda (_587 name588) (id?67 name588)) tmp586) (quote #f)) (apply (lambda (_589 name590) (values (quote define-form) (wrap95 name590 w554) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote (())) s555)) tmp586) (syntax-error tmp566))) (syntax-dispatch tmp566 (quote (any any)))))) (syntax-dispatch tmp566 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp566 (quote (any any any))))) e552) (if (memv t565 (quote (define-syntax))) ((lambda (tmp591) ((lambda (tmp592) (if (if tmp592 (apply (lambda (_593 name594 val595) (id?67 name594)) tmp592) (quote #f)) (apply (lambda (_596 name597 val598) (values (quote define-syntax-form) name597 val598 w554 s555)) tmp592) (syntax-error tmp591))) (syntax-dispatch tmp591 (quote (any any any))))) e552) (values (quote call) (quote #f) e552 w554 s555)))))))))))))) (values (quote call) (quote #f) e552 w554 s555)))) ((syntax-object?53 e552) (syntax-type101 (syntax-object-expression54 e552) r553 (join-wraps86 w554 (syntax-object-wrap55 e552)) (quote #f) rib556)) ((annotation?42 e552) (syntax-type101 (annotation-expression e552) r553 w554 (annotation-source e552) rib556)) ((let ((x599 e552)) (or (boolean? x599) (number? x599) (string? x599) (char? x599) (null? x599) (keyword? x599))) (values (quote constant) (quote #f) e552 w554 s555)) (else (values (quote other) (quote #f) e552 w554 s555))))) (chi-when-list100 (lambda (e600 when-list601 w602) (let f603 ((when-list604 when-list601) (situations605 (quote ()))) (if (null? when-list604) situations605 (f603 (cdr when-list604) (cons (let ((x606 (car when-list604))) (cond ((free-id=?90 x606 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote compile)) ((free-id=?90 x606 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote load)) ((free-id=?90 x606 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote eval)) (else (syntax-error (wrap95 x606 w602) (quote "invalid eval-when situation"))))) situations605)))))) (chi-install-global99 (lambda (name607 e608) (list (quote install-global-transformer) (list (quote quote) name607) e608))) (chi-top-sequence98 (lambda (body609 r610 w611 s612 m613 esew614) (build-sequence48 s612 (let dobody615 ((body616 body609) (r617 r610) (w618 w611) (m619 m613) (esew620 esew614)) (if (null? body616) (quote ()) (let ((first621 (chi-top102 (car body616) r617 w618 m619 esew620))) (cons first621 (dobody615 (cdr body616) r617 w618 m619 esew620)))))))) (chi-sequence97 (lambda (body622 r623 w624 s625) (build-sequence48 s625 (let dobody626 ((body627 body622) (r628 r623) (w629 w624)) (if (null? body627) (quote ()) (let ((first630 (chi103 (car body627) r628 w629))) (cons first630 (dobody626 (cdr body627) r628 w629)))))))) (source-wrap96 (lambda (x631 w632 s633) (wrap95 (if s633 (make-annotation x631 s633 (quote #f)) x631) w632))) (wrap95 (lambda (x634 w635) (cond ((and (null? (wrap-marks70 w635)) (null? (wrap-subst71 w635))) x634) ((syntax-object?53 x634) (make-syntax-object52 (syntax-object-expression54 x634) (join-wraps86 w635 (syntax-object-wrap55 x634)))) ((null? x634) x634) (else (make-syntax-object52 x634 w635))))) (bound-id-member?94 (lambda (x636 list637) (and (not (null? list637)) (or (bound-id=?91 x636 (car list637)) (bound-id-member?94 x636 (cdr list637)))))) (distinct-bound-ids?93 (lambda (ids638) (let distinct?639 ((ids640 ids638)) (or (null? ids640) (and (not (bound-id-member?94 (car ids640) (cdr ids640))) (distinct?639 (cdr ids640))))))) (valid-bound-ids?92 (lambda (ids641) (and (let all-ids?642 ((ids643 ids641)) (or (null? ids643) (and (id?67 (car ids643)) (all-ids?642 (cdr ids643))))) (distinct-bound-ids?93 ids641)))) (bound-id=?91 (lambda (i644 j645) (if (and (syntax-object?53 i644) (syntax-object?53 j645)) (and (eq? (let ((e646 (syntax-object-expression54 i644))) (if (annotation?42 e646) (annotation-expression e646) e646)) (let ((e647 (syntax-object-expression54 j645))) (if (annotation?42 e647) (annotation-expression e647) e647))) (same-marks?88 (wrap-marks70 (syntax-object-wrap55 i644)) (wrap-marks70 (syntax-object-wrap55 j645)))) (eq? (let ((e648 i644)) (if (annotation?42 e648) (annotation-expression e648) e648)) (let ((e649 j645)) (if (annotation?42 e649) (annotation-expression e649) e649)))))) (free-id=?90 (lambda (i650 j651) (and (eq? (let ((x652 i650)) (let ((e653 (if (syntax-object?53 x652) (syntax-object-expression54 x652) x652))) (if (annotation?42 e653) (annotation-expression e653) e653))) (let ((x654 j651)) (let ((e655 (if (syntax-object?53 x654) (syntax-object-expression54 x654) x654))) (if (annotation?42 e655) (annotation-expression e655) e655)))) (eq? (id-var-name89 i650 (quote (()))) (id-var-name89 j651 (quote (()))))))) (id-var-name89 (lambda (id656 w657) (letrec ((search-vector-rib660 (lambda (sym666 subst667 marks668 symnames669 ribcage670) (let ((n671 (vector-length symnames669))) (let f672 ((i673 (quote 0))) (cond ((fx=40 i673 n671) (search658 sym666 (cdr subst667) marks668)) ((and (eq? (vector-ref symnames669 i673) sym666) (same-marks?88 marks668 (vector-ref (ribcage-marks77 ribcage670) i673))) (values (vector-ref (ribcage-labels78 ribcage670) i673) marks668)) (else (f672 (fx+38 i673 (quote 1))))))))) (search-list-rib659 (lambda (sym674 subst675 marks676 symnames677 ribcage678) (let f679 ((symnames680 symnames677) (i681 (quote 0))) (cond ((null? symnames680) (search658 sym674 (cdr subst675) marks676)) ((and (eq? (car symnames680) sym674) (same-marks?88 marks676 (list-ref (ribcage-marks77 ribcage678) i681))) (values (list-ref (ribcage-labels78 ribcage678) i681) marks676)) (else (f679 (cdr symnames680) (fx+38 i681 (quote 1)))))))) (search658 (lambda (sym682 subst683 marks684) (if (null? subst683) (values (quote #f) marks684) (let ((fst685 (car subst683))) (if (eq? fst685 (quote shift)) (search658 sym682 (cdr subst683) (cdr marks684)) (let ((symnames686 (ribcage-symnames76 fst685))) (if (vector? symnames686) (search-vector-rib660 sym682 subst683 marks684 symnames686 fst685) (search-list-rib659 sym682 subst683 marks684 symnames686 fst685))))))))) (cond ((symbol? id656) (or (call-with-values (lambda () (search658 id656 (wrap-subst71 w657) (wrap-marks70 w657))) (lambda (x688 . ignore687) x688)) id656)) ((syntax-object?53 id656) (let ((id689 (let ((e691 (syntax-object-expression54 id656))) (if (annotation?42 e691) (annotation-expression e691) e691))) (w1690 (syntax-object-wrap55 id656))) (let ((marks692 (join-marks87 (wrap-marks70 w657) (wrap-marks70 w1690)))) (call-with-values (lambda () (search658 id689 (wrap-subst71 w657) marks692)) (lambda (new-id693 marks694) (or new-id693 (call-with-values (lambda () (search658 id689 (wrap-subst71 w1690) marks694)) (lambda (x696 . ignore695) x696)) id689)))))) ((annotation?42 id656) (let ((id697 (let ((e698 id656)) (if (annotation?42 e698) (annotation-expression e698) e698)))) (or (call-with-values (lambda () (search658 id697 (wrap-subst71 w657) (wrap-marks70 w657))) (lambda (x700 . ignore699) x700)) id697))) (else (error-hook45 (quote id-var-name) (quote "invalid id") id656)))))) (same-marks?88 (lambda (x701 y702) (or (eq? x701 y702) (and (not (null? x701)) (not (null? y702)) (eq? (car x701) (car y702)) (same-marks?88 (cdr x701) (cdr y702)))))) (join-marks87 (lambda (m1703 m2704) (smart-append85 m1703 m2704))) (join-wraps86 (lambda (w1705 w2706) (let ((m1707 (wrap-marks70 w1705)) (s1708 (wrap-subst71 w1705))) (if (null? m1707) (if (null? s1708) w2706 (make-wrap69 (wrap-marks70 w2706) (smart-append85 s1708 (wrap-subst71 w2706)))) (make-wrap69 (smart-append85 m1707 (wrap-marks70 w2706)) (smart-append85 s1708 (wrap-subst71 w2706))))))) (smart-append85 (lambda (m1709 m2710) (if (null? m2710) m1709 (append m1709 m2710)))) (make-binding-wrap84 (lambda (ids711 labels712 w713) (if (null? ids711) w713 (make-wrap69 (wrap-marks70 w713) (cons (let ((labelvec714 (list->vector labels712))) (let ((n715 (vector-length labelvec714))) (let ((symnamevec716 (make-vector n715)) (marksvec717 (make-vector n715))) (begin (let f718 ((ids719 ids711) (i720 (quote 0))) (if (not (null? ids719)) (call-with-values (lambda () (id-sym-name&marks68 (car ids719) w713)) (lambda (symname721 marks722) (begin (vector-set! symnamevec716 i720 symname721) (vector-set! marksvec717 i720 marks722) (f718 (cdr ids719) (fx+38 i720 (quote 1)))))))) (make-ribcage74 symnamevec716 marksvec717 labelvec714))))) (wrap-subst71 w713)))))) (extend-ribcage!83 (lambda (ribcage723 id724 label725) (begin (set-ribcage-symnames!79 ribcage723 (cons (let ((e726 (syntax-object-expression54 id724))) (if (annotation?42 e726) (annotation-expression e726) e726)) (ribcage-symnames76 ribcage723))) (set-ribcage-marks!80 ribcage723 (cons (wrap-marks70 (syntax-object-wrap55 id724)) (ribcage-marks77 ribcage723))) (set-ribcage-labels!81 ribcage723 (cons label725 (ribcage-labels78 ribcage723)))))) (anti-mark82 (lambda (w727) (make-wrap69 (cons (quote #f) (wrap-marks70 w727)) (cons (quote shift) (wrap-subst71 w727))))) (set-ribcage-labels!81 (lambda (x728 update729) (vector-set! x728 (quote 3) update729))) (set-ribcage-marks!80 (lambda (x730 update731) (vector-set! x730 (quote 2) update731))) (set-ribcage-symnames!79 (lambda (x732 update733) (vector-set! x732 (quote 1) update733))) (ribcage-labels78 (lambda (x734) (vector-ref x734 (quote 3)))) (ribcage-marks77 (lambda (x735) (vector-ref x735 (quote 2)))) (ribcage-symnames76 (lambda (x736) (vector-ref x736 (quote 1)))) (ribcage?75 (lambda (x737) (and (vector? x737) (= (vector-length x737) (quote 4)) (eq? (vector-ref x737 (quote 0)) (quote ribcage))))) (make-ribcage74 (lambda (symnames738 marks739 labels740) (vector (quote ribcage) symnames738 marks739 labels740))) (gen-labels73 (lambda (ls741) (if (null? ls741) (quote ()) (cons (gen-label72) (gen-labels73 (cdr ls741)))))) (gen-label72 (lambda () (string (quote #\i)))) (wrap-subst71 cdr) (wrap-marks70 car) (make-wrap69 cons) (id-sym-name&marks68 (lambda (x742 w743) (if (syntax-object?53 x742) (values (let ((e744 (syntax-object-expression54 x742))) (if (annotation?42 e744) (annotation-expression e744) e744)) (join-marks87 (wrap-marks70 w743) (wrap-marks70 (syntax-object-wrap55 x742)))) (values (let ((e745 x742)) (if (annotation?42 e745) (annotation-expression e745) e745)) (wrap-marks70 w743))))) (id?67 (lambda (x746) (cond ((symbol? x746) (quote #t)) ((syntax-object?53 x746) (symbol? (let ((e747 (syntax-object-expression54 x746))) (if (annotation?42 e747) (annotation-expression e747) e747)))) ((annotation?42 x746) (symbol? (annotation-expression x746))) (else (quote #f))))) (nonsymbol-id?66 (lambda (x748) (and (syntax-object?53 x748) (symbol? (let ((e749 (syntax-object-expression54 x748))) (if (annotation?42 e749) (annotation-expression e749) e749)))))) (global-extend65 (lambda (type750 sym751 val752) (put-global-definition-hook46 sym751 (cons type750 val752)))) (lookup64 (lambda (x753 r754) (cond ((assq x753 r754) => cdr) ((symbol? x753) (or (get-global-definition-hook47 x753) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env63 (lambda (r755) (if (null? r755) (quote ()) (let ((a756 (car r755))) (if (eq? (cadr a756) (quote macro)) (cons a756 (macros-only-env63 (cdr r755))) (macros-only-env63 (cdr r755))))))) (extend-var-env62 (lambda (labels757 vars758 r759) (if (null? labels757) r759 (extend-var-env62 (cdr labels757) (cdr vars758) (cons (cons (car labels757) (cons (quote lexical) (car vars758))) r759))))) (extend-env61 (lambda (labels760 bindings761 r762) (if (null? labels760) r762 (extend-env61 (cdr labels760) (cdr bindings761) (cons (cons (car labels760) (car bindings761)) r762))))) (binding-value60 cdr) (binding-type59 car) (source-annotation58 (lambda (x763) (cond ((annotation?42 x763) (annotation-source x763)) ((syntax-object?53 x763) (source-annotation58 (syntax-object-expression54 x763))) (else (quote #f))))) (set-syntax-object-wrap!57 (lambda (x764 update765) (vector-set! x764 (quote 2) update765))) (set-syntax-object-expression!56 (lambda (x766 update767) (vector-set! x766 (quote 1) update767))) (syntax-object-wrap55 (lambda (x768) (vector-ref x768 (quote 2)))) (syntax-object-expression54 (lambda (x769) (vector-ref x769 (quote 1)))) (syntax-object?53 (lambda (x770) (and (vector? x770) (= (vector-length x770) (quote 3)) (eq? (vector-ref x770 (quote 0)) (quote syntax-object))))) (make-syntax-object52 (lambda (expression771 wrap772) (vector (quote syntax-object) expression771 wrap772))) (build-letrec51 (lambda (src773 vars774 val-exps775 body-exp776) (if (null? vars774) body-exp776 (list (quote letrec) (map list vars774 val-exps775) body-exp776)))) (build-named-let50 (lambda (src777 vars778 val-exps779 body-exp780) (if (null? vars778) body-exp780 (list (quote let) (car vars778) (map list (cdr vars778) val-exps779) body-exp780)))) (build-let49 (lambda (src781 vars782 val-exps783 body-exp784) (if (null? vars782) body-exp784 (list (quote let) (map list vars782 val-exps783) body-exp784)))) (build-sequence48 (lambda (src785 exps786) (if (null? (cdr exps786)) (car exps786) (cons (quote begin) exps786)))) (get-global-definition-hook47 (lambda (symbol787) (getprop symbol787 (quote *sc-expander*)))) (put-global-definition-hook46 (lambda (symbol788 binding789) (putprop symbol788 (quote *sc-expander*) binding789))) (error-hook45 (lambda (who790 why791 what792) (error who790 (quote "~a ~s") why791 what792))) (local-eval-hook44 (lambda (x793) (eval (list noexpand37 x793) (interaction-environment)))) (top-level-eval-hook43 (lambda (x794) (eval (list noexpand37 x794) (interaction-environment)))) (annotation?42 (lambda (x795) (quote #f))) (fx<41 <) (fx=40 =) (fx-39 -) (fx+38 +) (noexpand37 (quote "noexpand"))) (begin (global-extend65 (quote local-syntax) (quote letrec-syntax) (quote #t)) (global-extend65 (quote local-syntax) (quote let-syntax) (quote #f)) (global-extend65 (quote core) (quote fluid-let-syntax) (lambda (e796 r797 w798 s799) ((lambda (tmp800) ((lambda (tmp801) (if (if tmp801 (apply (lambda (_802 var803 val804 e1805 e2806) (valid-bound-ids?92 var803)) tmp801) (quote #f)) (apply (lambda (_808 var809 val810 e1811 e2812) (let ((names813 (map (lambda (x814) (id-var-name89 x814 w798)) var809))) (begin (for-each (lambda (id816 n817) (let ((t818 (binding-type59 (lookup64 n817 r797)))) (if (memv t818 (quote (displaced-lexical))) (syntax-error (source-wrap96 id816 w798 s799) (quote "identifier out of context"))))) var809 names813) (chi-body107 (cons e1811 e2812) (source-wrap96 e796 w798 s799) (extend-env61 names813 (let ((trans-r821 (macros-only-env63 r797))) (map (lambda (x822) (cons (quote macro) (eval-local-transformer110 (chi103 x822 trans-r821 w798)))) val810)) r797) w798)))) tmp801) ((lambda (_824) (syntax-error (source-wrap96 e796 w798 s799))) tmp800))) (syntax-dispatch tmp800 (quote (any #(each (any any)) any . each-any))))) e796))) (global-extend65 (quote core) (quote quote) (lambda (e825 r826 w827 s828) ((lambda (tmp829) ((lambda (tmp830) (if tmp830 (apply (lambda (_831 e832) (list (quote quote) (strip114 e832 w827))) tmp830) ((lambda (_833) (syntax-error (source-wrap96 e825 w827 s828))) tmp829))) (syntax-dispatch tmp829 (quote (any any))))) e825))) (global-extend65 (quote core) (quote syntax) (letrec ((regen841 (lambda (x842) (let ((t843 (car x842))) (if (memv t843 (quote (ref))) (cadr x842) (if (memv t843 (quote (primitive))) (cadr x842) (if (memv t843 (quote (quote))) (list (quote quote) (cadr x842)) (if (memv t843 (quote (lambda))) (list (quote lambda) (cadr x842) (regen841 (caddr x842))) (if (memv t843 (quote (map))) (let ((ls844 (map regen841 (cdr x842)))) (cons (if (fx=40 (length ls844) (quote 2)) (quote map) (quote map)) ls844)) (cons (car x842) (map regen841 (cdr x842))))))))))) (gen-vector840 (lambda (x845) (cond ((eq? (car x845) (quote list)) (cons (quote vector) (cdr x845))) ((eq? (car x845) (quote quote)) (list (quote quote) (list->vector (cadr x845)))) (else (list (quote list->vector) x845))))) (gen-append839 (lambda (x846 y847) (if (equal? y847 (quote (quote ()))) x846 (list (quote append) x846 y847)))) (gen-cons838 (lambda (x848 y849) (let ((t850 (car y849))) (if (memv t850 (quote (quote))) (if (eq? (car x848) (quote quote)) (list (quote quote) (cons (cadr x848) (cadr y849))) (if (eq? (cadr y849) (quote ())) (list (quote list) x848) (list (quote cons) x848 y849))) (if (memv t850 (quote (list))) (cons (quote list) (cons x848 (cdr y849))) (list (quote cons) x848 y849)))))) (gen-map837 (lambda (e851 map-env852) (let ((formals853 (map cdr map-env852)) (actuals854 (map (lambda (x855) (list (quote ref) (car x855))) map-env852))) (cond ((eq? (car e851) (quote ref)) (car actuals854)) ((andmap (lambda (x856) (and (eq? (car x856) (quote ref)) (memq (cadr x856) formals853))) (cdr e851)) (cons (quote map) (cons (list (quote primitive) (car e851)) (map (let ((r857 (map cons formals853 actuals854))) (lambda (x858) (cdr (assq (cadr x858) r857)))) (cdr e851))))) (else (cons (quote map) (cons (list (quote lambda) formals853 e851) actuals854))))))) (gen-mappend836 (lambda (e859 map-env860) (list (quote apply) (quote (primitive append)) (gen-map837 e859 map-env860)))) (gen-ref835 (lambda (src861 var862 level863 maps864) (if (fx=40 level863 (quote 0)) (values var862 maps864) (if (null? maps864) (syntax-error src861 (quote "missing ellipsis in syntax form")) (call-with-values (lambda () (gen-ref835 src861 var862 (fx-39 level863 (quote 1)) (cdr maps864))) (lambda (outer-var865 outer-maps866) (let ((b867 (assq outer-var865 (car maps864)))) (if b867 (values (cdr b867) maps864) (let ((inner-var868 (gen-var115 (quote tmp)))) (values inner-var868 (cons (cons (cons outer-var865 inner-var868) (car maps864)) outer-maps866))))))))))) (gen-syntax834 (lambda (src869 e870 r871 maps872 ellipsis?873) (if (id?67 e870) (let ((label874 (id-var-name89 e870 (quote (()))))) (let ((b875 (lookup64 label874 r871))) (if (eq? (binding-type59 b875) (quote syntax)) (call-with-values (lambda () (let ((var.lev876 (binding-value60 b875))) (gen-ref835 src869 (car var.lev876) (cdr var.lev876) maps872))) (lambda (var877 maps878) (values (list (quote ref) var877) maps878))) (if (ellipsis?873 e870) (syntax-error src869 (quote "misplaced ellipsis in syntax form")) (values (list (quote quote) e870) maps872))))) ((lambda (tmp879) ((lambda (tmp880) (if (if tmp880 (apply (lambda (dots881 e882) (ellipsis?873 dots881)) tmp880) (quote #f)) (apply (lambda (dots883 e884) (gen-syntax834 src869 e884 r871 maps872 (lambda (x885) (quote #f)))) tmp880) ((lambda (tmp886) (if (if tmp886 (apply (lambda (x887 dots888 y889) (ellipsis?873 dots888)) tmp886) (quote #f)) (apply (lambda (x890 dots891 y892) (let f893 ((y894 y892) (k895 (lambda (maps896) (call-with-values (lambda () (gen-syntax834 src869 x890 r871 (cons (quote ()) maps896) ellipsis?873)) (lambda (x897 maps898) (if (null? (car maps898)) (syntax-error src869 (quote "extra ellipsis in syntax form")) (values (gen-map837 x897 (car maps898)) (cdr maps898)))))))) ((lambda (tmp899) ((lambda (tmp900) (if (if tmp900 (apply (lambda (dots901 y902) (ellipsis?873 dots901)) tmp900) (quote #f)) (apply (lambda (dots903 y904) (f893 y904 (lambda (maps905) (call-with-values (lambda () (k895 (cons (quote ()) maps905))) (lambda (x906 maps907) (if (null? (car maps907)) (syntax-error src869 (quote "extra ellipsis in syntax form")) (values (gen-mappend836 x906 (car maps907)) (cdr maps907)))))))) tmp900) ((lambda (_908) (call-with-values (lambda () (gen-syntax834 src869 y894 r871 maps872 ellipsis?873)) (lambda (y909 maps910) (call-with-values (lambda () (k895 maps910)) (lambda (x911 maps912) (values (gen-append839 x911 y909) maps912)))))) tmp899))) (syntax-dispatch tmp899 (quote (any . any))))) y894))) tmp886) ((lambda (tmp913) (if tmp913 (apply (lambda (x914 y915) (call-with-values (lambda () (gen-syntax834 src869 x914 r871 maps872 ellipsis?873)) (lambda (x916 maps917) (call-with-values (lambda () (gen-syntax834 src869 y915 r871 maps917 ellipsis?873)) (lambda (y918 maps919) (values (gen-cons838 x916 y918) maps919)))))) tmp913) ((lambda (tmp920) (if tmp920 (apply (lambda (e1921 e2922) (call-with-values (lambda () (gen-syntax834 src869 (cons e1921 e2922) r871 maps872 ellipsis?873)) (lambda (e924 maps925) (values (gen-vector840 e924) maps925)))) tmp920) ((lambda (_926) (values (list (quote quote) e870) maps872)) tmp879))) (syntax-dispatch tmp879 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp879 (quote (any . any)))))) (syntax-dispatch tmp879 (quote (any any . any)))))) (syntax-dispatch tmp879 (quote (any any))))) e870))))) (lambda (e927 r928 w929 s930) (let ((e931 (source-wrap96 e927 w929 s930))) ((lambda (tmp932) ((lambda (tmp933) (if tmp933 (apply (lambda (_934 x935) (call-with-values (lambda () (gen-syntax834 e931 x935 r928 (quote ()) ellipsis?112)) (lambda (e936 maps937) (regen841 e936)))) tmp933) ((lambda (_938) (syntax-error e931)) tmp932))) (syntax-dispatch tmp932 (quote (any any))))) e931))))) (global-extend65 (quote core) (quote lambda) (lambda (e939 r940 w941 s942) ((lambda (tmp943) ((lambda (tmp944) (if tmp944 (apply (lambda (_945 c946) (chi-lambda-clause108 (source-wrap96 e939 w941 s942) c946 r940 w941 (lambda (vars947 body948) (list (quote lambda) vars947 body948)))) tmp944) (syntax-error tmp943))) (syntax-dispatch tmp943 (quote (any . any))))) e939))) (global-extend65 (quote core) (quote let) (letrec ((chi-let949 (lambda (e950 r951 w952 s953 constructor954 ids955 vals956 exps957) (if (not (valid-bound-ids?92 ids955)) (syntax-error e950 (quote "duplicate bound variable in")) (let ((labels958 (gen-labels73 ids955)) (new-vars959 (map gen-var115 ids955))) (let ((nw960 (make-binding-wrap84 ids955 labels958 w952)) (nr961 (extend-var-env62 labels958 new-vars959 r951))) (constructor954 s953 new-vars959 (map (lambda (x962) (chi103 x962 r951 w952)) vals956) (chi-body107 exps957 (source-wrap96 e950 nw960 s953) nr961 nw960)))))))) (lambda (e963 r964 w965 s966) ((lambda (tmp967) ((lambda (tmp968) (if tmp968 (apply (lambda (_969 id970 val971 e1972 e2973) (chi-let949 e963 r964 w965 s966 build-let49 id970 val971 (cons e1972 e2973))) tmp968) ((lambda (tmp977) (if (if tmp977 (apply (lambda (_978 f979 id980 val981 e1982 e2983) (id?67 f979)) tmp977) (quote #f)) (apply (lambda (_984 f985 id986 val987 e1988 e2989) (chi-let949 e963 r964 w965 s966 build-named-let50 (cons f985 id986) val987 (cons e1988 e2989))) tmp977) ((lambda (_993) (syntax-error (source-wrap96 e963 w965 s966))) tmp967))) (syntax-dispatch tmp967 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp967 (quote (any #(each (any any)) any . each-any))))) e963)))) (global-extend65 (quote core) (quote letrec) (lambda (e994 r995 w996 s997) ((lambda (tmp998) ((lambda (tmp999) (if tmp999 (apply (lambda (_1000 id1001 val1002 e11003 e21004) (let ((ids1005 id1001)) (if (not (valid-bound-ids?92 ids1005)) (syntax-error e994 (quote "duplicate bound variable in")) (let ((labels1007 (gen-labels73 ids1005)) (new-vars1008 (map gen-var115 ids1005))) (let ((w1009 (make-binding-wrap84 ids1005 labels1007 w996)) (r1010 (extend-var-env62 labels1007 new-vars1008 r995))) (build-letrec51 s997 new-vars1008 (map (lambda (x1011) (chi103 x1011 r1010 w1009)) val1002) (chi-body107 (cons e11003 e21004) (source-wrap96 e994 w1009 s997) r1010 w1009))))))) tmp999) ((lambda (_1014) (syntax-error (source-wrap96 e994 w996 s997))) tmp998))) (syntax-dispatch tmp998 (quote (any #(each (any any)) any . each-any))))) e994))) (global-extend65 (quote core) (quote set!) (lambda (e1015 r1016 w1017 s1018) ((lambda (tmp1019) ((lambda (tmp1020) (if (if tmp1020 (apply (lambda (_1021 id1022 val1023) (id?67 id1022)) tmp1020) (quote #f)) (apply (lambda (_1024 id1025 val1026) (let ((val1027 (chi103 val1026 r1016 w1017)) (n1028 (id-var-name89 id1025 w1017))) (let ((b1029 (lookup64 n1028 r1016))) (let ((t1030 (binding-type59 b1029))) (if (memv t1030 (quote (lexical))) (list (quote set!) (binding-value60 b1029) val1027) (if (memv t1030 (quote (global))) (list (quote set!) n1028 val1027) (if (memv t1030 (quote (displaced-lexical))) (syntax-error (wrap95 id1025 w1017) (quote "identifier out of context")) (syntax-error (source-wrap96 e1015 w1017 s1018))))))))) tmp1020) ((lambda (tmp1031) (if tmp1031 (apply (lambda (_1032 getter1033 arg1034 val1035) (cons (chi103 (list (quote #(syntax-object setter ((top) #(ribcage #(_ getter arg val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) getter1033) r1016 w1017) (map (lambda (e1036) (chi103 e1036 r1016 w1017)) (append arg1034 (list val1035))))) tmp1031) ((lambda (_1038) (syntax-error (source-wrap96 e1015 w1017 s1018))) tmp1019))) (syntax-dispatch tmp1019 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp1019 (quote (any any any))))) e1015))) (global-extend65 (quote begin) (quote begin) (quote ())) (global-extend65 (quote define) (quote define) (quote ())) (global-extend65 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend65 (quote eval-when) (quote eval-when) (quote ())) (global-extend65 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1042 (lambda (x1043 keys1044 clauses1045 r1046) (if (null? clauses1045) (list (quote syntax-error) x1043) ((lambda (tmp1047) ((lambda (tmp1048) (if tmp1048 (apply (lambda (pat1049 exp1050) (if (and (id?67 pat1049) (andmap (lambda (x1051) (not (free-id=?90 pat1049 x1051))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((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) (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) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) keys1044))) (let ((labels1052 (list (gen-label72))) (var1053 (gen-var115 pat1049))) (list (list (quote lambda) (list var1053) (chi103 exp1050 (extend-env61 labels1052 (list (cons (quote syntax) (cons var1053 (quote 0)))) r1046) (make-binding-wrap84 (list pat1049) labels1052 (quote (()))))) x1043)) (gen-clause1041 x1043 keys1044 (cdr clauses1045) r1046 pat1049 (quote #t) exp1050))) tmp1048) ((lambda (tmp1054) (if tmp1054 (apply (lambda (pat1055 fender1056 exp1057) (gen-clause1041 x1043 keys1044 (cdr clauses1045) r1046 pat1055 fender1056 exp1057)) tmp1054) ((lambda (_1058) (syntax-error (car clauses1045) (quote "invalid syntax-case clause"))) tmp1047))) (syntax-dispatch tmp1047 (quote (any any any)))))) (syntax-dispatch tmp1047 (quote (any any))))) (car clauses1045))))) (gen-clause1041 (lambda (x1059 keys1060 clauses1061 r1062 pat1063 fender1064 exp1065) (call-with-values (lambda () (convert-pattern1039 pat1063 keys1060)) (lambda (p1066 pvars1067) (cond ((not (distinct-bound-ids?93 (map car pvars1067))) (syntax-error pat1063 (quote "duplicate pattern variable in syntax-case pattern"))) ((not (andmap (lambda (x1068) (not (ellipsis?112 (car x1068)))) pvars1067)) (syntax-error pat1063 (quote "misplaced ellipsis in syntax-case pattern"))) (else (let ((y1069 (gen-var115 (quote tmp)))) (list (list (quote lambda) (list y1069) (let ((y1070 y1069)) (list (quote if) ((lambda (tmp1071) ((lambda (tmp1072) (if tmp1072 (apply (lambda () y1070) tmp1072) ((lambda (_1073) (list (quote if) y1070 (build-dispatch-call1040 pvars1067 fender1064 y1070 r1062) (list (quote quote) (quote #f)))) tmp1071))) (syntax-dispatch tmp1071 (quote #(atom #t))))) fender1064) (build-dispatch-call1040 pvars1067 exp1065 y1070 r1062) (gen-syntax-case1042 x1059 keys1060 clauses1061 r1062)))) (if (eq? p1066 (quote any)) (list (quote list) x1059) (list (quote syntax-dispatch) x1059 (list (quote quote) p1066))))))))))) (build-dispatch-call1040 (lambda (pvars1074 exp1075 y1076 r1077) (let ((ids1078 (map car pvars1074)) (levels1079 (map cdr pvars1074))) (let ((labels1080 (gen-labels73 ids1078)) (new-vars1081 (map gen-var115 ids1078))) (list (quote apply) (list (quote lambda) new-vars1081 (chi103 exp1075 (extend-env61 labels1080 (map (lambda (var1082 level1083) (cons (quote syntax) (cons var1082 level1083))) new-vars1081 (map cdr pvars1074)) r1077) (make-binding-wrap84 ids1078 labels1080 (quote (()))))) y1076))))) (convert-pattern1039 (lambda (pattern1084 keys1085) (let cvt1086 ((p1087 pattern1084) (n1088 (quote 0)) (ids1089 (quote ()))) (if (id?67 p1087) (if (bound-id-member?94 p1087 keys1085) (values (vector (quote free-id) p1087) ids1089) (values (quote any) (cons (cons p1087 n1088) ids1089))) ((lambda (tmp1090) ((lambda (tmp1091) (if (if tmp1091 (apply (lambda (x1092 dots1093) (ellipsis?112 dots1093)) tmp1091) (quote #f)) (apply (lambda (x1094 dots1095) (call-with-values (lambda () (cvt1086 x1094 (fx+38 n1088 (quote 1)) ids1089)) (lambda (p1096 ids1097) (values (if (eq? p1096 (quote any)) (quote each-any) (vector (quote each) p1096)) ids1097)))) tmp1091) ((lambda (tmp1098) (if tmp1098 (apply (lambda (x1099 y1100) (call-with-values (lambda () (cvt1086 y1100 n1088 ids1089)) (lambda (y1101 ids1102) (call-with-values (lambda () (cvt1086 x1099 n1088 ids1102)) (lambda (x1103 ids1104) (values (cons x1103 y1101) ids1104)))))) tmp1098) ((lambda (tmp1105) (if tmp1105 (apply (lambda () (values (quote ()) ids1089)) tmp1105) ((lambda (tmp1106) (if tmp1106 (apply (lambda (x1107) (call-with-values (lambda () (cvt1086 x1107 n1088 ids1089)) (lambda (p1109 ids1110) (values (vector (quote vector) p1109) ids1110)))) tmp1106) ((lambda (x1111) (values (vector (quote atom) (strip114 p1087 (quote (())))) ids1089)) tmp1090))) (syntax-dispatch tmp1090 (quote #(vector each-any)))))) (syntax-dispatch tmp1090 (quote ()))))) (syntax-dispatch tmp1090 (quote (any . any)))))) (syntax-dispatch tmp1090 (quote (any any))))) p1087)))))) (lambda (e1112 r1113 w1114 s1115) (let ((e1116 (source-wrap96 e1112 w1114 s1115))) ((lambda (tmp1117) ((lambda (tmp1118) (if tmp1118 (apply (lambda (_1119 val1120 key1121 m1122) (if (andmap (lambda (x1123) (and (id?67 x1123) (not (ellipsis?112 x1123)))) key1121) (let ((x1125 (gen-var115 (quote tmp)))) (list (list (quote lambda) (list x1125) (gen-syntax-case1042 x1125 key1121 m1122 r1113)) (chi103 val1120 r1113 (quote (()))))) (syntax-error e1116 (quote "invalid literals list in")))) tmp1118) (syntax-error tmp1117))) (syntax-dispatch tmp1117 (quote (any any each-any . each-any))))) e1116))))) (set! sc-expand (let ((m1128 (quote e)) (esew1129 (quote (eval)))) (lambda (x1130) (if (and (pair? x1130) (equal? (car x1130) noexpand37)) (cadr x1130) (chi-top102 x1130 (quote ()) (quote ((top))) m1128 esew1129))))) (set! sc-expand3 (let ((m1131 (quote e)) (esew1132 (quote (eval)))) (lambda (x1134 . rest1133) (if (and (pair? x1134) (equal? (car x1134) noexpand37)) (cadr x1134) (chi-top102 x1134 (quote ()) (quote ((top))) (if (null? rest1133) m1131 (car rest1133)) (if (or (null? rest1133) (null? (cdr rest1133))) esew1132 (cadr rest1133))))))) (set! identifier? (lambda (x1135) (nonsymbol-id?66 x1135))) (set! datum->syntax-object (lambda (id1136 datum1137) (begin (let ((x1138 id1136)) (if (not (nonsymbol-id?66 x1138)) (error-hook45 (quote datum->syntax-object) (quote "invalid argument") x1138))) (make-syntax-object52 datum1137 (syntax-object-wrap55 id1136))))) (set! syntax-object->datum (lambda (x1139) (strip114 x1139 (quote (()))))) (set! generate-temporaries (lambda (ls1140) (begin (let ((x1141 ls1140)) (if (not (list? x1141)) (error-hook45 (quote generate-temporaries) (quote "invalid argument") x1141))) (map (lambda (x1142) (wrap95 (gensym) (quote ((top))))) ls1140)))) (set! free-identifier=? (lambda (x1143 y1144) (begin (let ((x1145 x1143)) (if (not (nonsymbol-id?66 x1145)) (error-hook45 (quote free-identifier=?) (quote "invalid argument") x1145))) (let ((x1146 y1144)) (if (not (nonsymbol-id?66 x1146)) (error-hook45 (quote free-identifier=?) (quote "invalid argument") x1146))) (free-id=?90 x1143 y1144)))) (set! bound-identifier=? (lambda (x1147 y1148) (begin (let ((x1149 x1147)) (if (not (nonsymbol-id?66 x1149)) (error-hook45 (quote bound-identifier=?) (quote "invalid argument") x1149))) (let ((x1150 y1148)) (if (not (nonsymbol-id?66 x1150)) (error-hook45 (quote bound-identifier=?) (quote "invalid argument") x1150))) (bound-id=?91 x1147 y1148)))) (set! syntax-error (lambda (object1152 . messages1151) (begin (for-each (lambda (x1153) (let ((x1154 x1153)) (if (not (string? x1154)) (error-hook45 (quote syntax-error) (quote "invalid argument") x1154)))) messages1151) (let ((message1155 (if (null? messages1151) (quote "invalid syntax") (apply string-append messages1151)))) (error-hook45 (quote #f) message1155 (strip114 object1152 (quote (())))))))) (set! install-global-transformer (lambda (sym1156 v1157) (begin (let ((x1158 sym1156)) (if (not (symbol? x1158)) (error-hook45 (quote define-syntax) (quote "invalid argument") x1158))) (let ((x1159 v1157)) (if (not (procedure? x1159)) (error-hook45 (quote define-syntax) (quote "invalid argument") x1159))) (global-extend65 (quote macro) sym1156 v1157)))) (letrec ((match1164 (lambda (e1165 p1166 w1167 r1168) (cond ((not r1168) (quote #f)) ((eq? p1166 (quote any)) (cons (wrap95 e1165 w1167) r1168)) ((syntax-object?53 e1165) (match*1163 (let ((e1169 (syntax-object-expression54 e1165))) (if (annotation?42 e1169) (annotation-expression e1169) e1169)) p1166 (join-wraps86 w1167 (syntax-object-wrap55 e1165)) r1168)) (else (match*1163 (let ((e1170 e1165)) (if (annotation?42 e1170) (annotation-expression e1170) e1170)) p1166 w1167 r1168))))) (match*1163 (lambda (e1171 p1172 w1173 r1174) (cond ((null? p1172) (and (null? e1171) r1174)) ((pair? p1172) (and (pair? e1171) (match1164 (car e1171) (car p1172) w1173 (match1164 (cdr e1171) (cdr p1172) w1173 r1174)))) ((eq? p1172 (quote each-any)) (let ((l1175 (match-each-any1161 e1171 w1173))) (and l1175 (cons l1175 r1174)))) (else (let ((t1176 (vector-ref p1172 (quote 0)))) (if (memv t1176 (quote (each))) (if (null? e1171) (match-empty1162 (vector-ref p1172 (quote 1)) r1174) (let ((l1177 (match-each1160 e1171 (vector-ref p1172 (quote 1)) w1173))) (and l1177 (let collect1178 ((l1179 l1177)) (if (null? (car l1179)) r1174 (cons (map car l1179) (collect1178 (map cdr l1179)))))))) (if (memv t1176 (quote (free-id))) (and (id?67 e1171) (free-id=?90 (wrap95 e1171 w1173) (vector-ref p1172 (quote 1))) r1174) (if (memv t1176 (quote (atom))) (and (equal? (vector-ref p1172 (quote 1)) (strip114 e1171 w1173)) r1174) (if (memv t1176 (quote (vector))) (and (vector? e1171) (match1164 (vector->list e1171) (vector-ref p1172 (quote 1)) w1173 r1174))))))))))) (match-empty1162 (lambda (p1180 r1181) (cond ((null? p1180) r1181) ((eq? p1180 (quote any)) (cons (quote ()) r1181)) ((pair? p1180) (match-empty1162 (car p1180) (match-empty1162 (cdr p1180) r1181))) ((eq? p1180 (quote each-any)) (cons (quote ()) r1181)) (else (let ((t1182 (vector-ref p1180 (quote 0)))) (if (memv t1182 (quote (each))) (match-empty1162 (vector-ref p1180 (quote 1)) r1181) (if (memv t1182 (quote (free-id atom))) r1181 (if (memv t1182 (quote (vector))) (match-empty1162 (vector-ref p1180 (quote 1)) r1181))))))))) (match-each-any1161 (lambda (e1183 w1184) (cond ((annotation?42 e1183) (match-each-any1161 (annotation-expression e1183) w1184)) ((pair? e1183) (let ((l1185 (match-each-any1161 (cdr e1183) w1184))) (and l1185 (cons (wrap95 (car e1183) w1184) l1185)))) ((null? e1183) (quote ())) ((syntax-object?53 e1183) (match-each-any1161 (syntax-object-expression54 e1183) (join-wraps86 w1184 (syntax-object-wrap55 e1183)))) (else (quote #f))))) (match-each1160 (lambda (e1186 p1187 w1188) (cond ((annotation?42 e1186) (match-each1160 (annotation-expression e1186) p1187 w1188)) ((pair? e1186) (let ((first1189 (match1164 (car e1186) p1187 w1188 (quote ())))) (and first1189 (let ((rest1190 (match-each1160 (cdr e1186) p1187 w1188))) (and rest1190 (cons first1189 rest1190)))))) ((null? e1186) (quote ())) ((syntax-object?53 e1186) (match-each1160 (syntax-object-expression54 e1186) p1187 (join-wraps86 w1188 (syntax-object-wrap55 e1186)))) (else (quote #f)))))) (set! syntax-dispatch (lambda (e1191 p1192) (cond ((eq? p1192 (quote any)) (list e1191)) ((syntax-object?53 e1191) (match*1163 (let ((e1193 (syntax-object-expression54 e1191))) (if (annotation?42 e1193) (annotation-expression e1193) e1193)) p1192 (syntax-object-wrap55 e1191) (quote ()))) (else (match*1163 (let ((e1194 e1191)) (if (annotation?42 e1194) (annotation-expression e1194) e1194)) p1192 (quote (())) (quote ()))))))))) +(install-global-transformer (quote with-syntax) (lambda (x1195) ((lambda (tmp1196) ((lambda (tmp1197) (if tmp1197 (apply (lambda (_1198 e11199 e21200) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11199 e21200))) tmp1197) ((lambda (tmp1202) (if tmp1202 (apply (lambda (_1203 out1204 in1205 e11206 e21207) (list (quote #(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"))))) in1205 (quote ()) (list out1204 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11206 e21207))))) tmp1202) ((lambda (tmp1209) (if tmp1209 (apply (lambda (_1210 out1211 in1212 e11213 e21214) (list (quote #(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"))))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) in1212) (quote ()) (list out1211 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11213 e21214))))) tmp1209) (syntax-error tmp1196))) (syntax-dispatch tmp1196 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp1196 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp1196 (quote (any () any . each-any))))) x1195))) +(install-global-transformer (quote syntax-rules) (lambda (x1218) ((lambda (tmp1219) ((lambda (tmp1220) (if tmp1220 (apply (lambda (_1221 k1222 keyword1223 pattern1224 template1225) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons k1222 (map (lambda (tmp1228 tmp1227) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) tmp1227) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) tmp1228))) template1225 pattern1224)))))) tmp1220) (syntax-error tmp1219))) (syntax-dispatch tmp1219 (quote (any each-any . #(each ((any . any) any))))))) x1218))) +(install-global-transformer (quote let*) (lambda (x1229) ((lambda (tmp1230) ((lambda (tmp1231) (if (if tmp1231 (apply (lambda (let*1232 x1233 v1234 e11235 e21236) (andmap identifier? x1233)) tmp1231) (quote #f)) (apply (lambda (let*1238 x1239 v1240 e11241 e21242) (let f1243 ((bindings1244 (map list x1239 v1240))) (if (null? bindings1244) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote ()) (cons e11241 e21242))) ((lambda (tmp1248) ((lambda (tmp1249) (if tmp1249 (apply (lambda (body1250 binding1251) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list binding1251) body1250)) tmp1249) (syntax-error tmp1248))) (syntax-dispatch tmp1248 (quote (any any))))) (list (f1243 (cdr bindings1244)) (car bindings1244)))))) tmp1231) (syntax-error tmp1230))) (syntax-dispatch tmp1230 (quote (any #(each (any any)) any . each-any))))) x1229))) +(install-global-transformer (quote do) (lambda (orig-x1252) ((lambda (tmp1253) ((lambda (tmp1254) (if tmp1254 (apply (lambda (_1255 var1256 init1257 step1258 e01259 e11260 c1261) ((lambda (tmp1262) ((lambda (tmp1263) (if tmp1263 (apply (lambda (step1264) ((lambda (tmp1265) ((lambda (tmp1266) (if tmp1266 (apply (lambda () (list (quote #(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"))))) (quote #(syntax-object doloop ((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"))))) (map list var1256 init1257) (list (quote #(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"))))) (list (quote #(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"))))) e01259) (cons (quote #(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"))))) (append c1261 (list (cons (quote #(syntax-object doloop ((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"))))) step1264))))))) tmp1266) ((lambda (tmp1271) (if tmp1271 (apply (lambda (e11272 e21273) (list (quote #(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"))))) (quote #(syntax-object doloop ((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"))))) (map list var1256 init1257) (list (quote #(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"))))) e01259 (cons (quote #(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"))))) (cons e11272 e21273)) (cons (quote #(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"))))) (append c1261 (list (cons (quote #(syntax-object doloop ((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"))))) step1264))))))) tmp1271) (syntax-error tmp1265))) (syntax-dispatch tmp1265 (quote (any . each-any)))))) (syntax-dispatch tmp1265 (quote ())))) e11260)) tmp1263) (syntax-error tmp1262))) (syntax-dispatch tmp1262 (quote each-any)))) (map (lambda (v1280 s1281) ((lambda (tmp1282) ((lambda (tmp1283) (if tmp1283 (apply (lambda () v1280) tmp1283) ((lambda (tmp1284) (if tmp1284 (apply (lambda (e1285) e1285) tmp1284) ((lambda (_1286) (syntax-error orig-x1252)) tmp1282))) (syntax-dispatch tmp1282 (quote (any)))))) (syntax-dispatch tmp1282 (quote ())))) s1281)) var1256 step1258))) tmp1254) (syntax-error tmp1253))) (syntax-dispatch tmp1253 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1252))) +(install-global-transformer (quote quasiquote) (letrec ((quasicons1289 (lambda (x1293 y1294) ((lambda (tmp1295) ((lambda (tmp1296) (if tmp1296 (apply (lambda (x1297 y1298) ((lambda (tmp1299) ((lambda (tmp1300) (if tmp1300 (apply (lambda (dy1301) ((lambda (tmp1302) ((lambda (tmp1303) (if tmp1303 (apply (lambda (dx1304) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons dx1304 dy1301))) tmp1303) ((lambda (_1305) (if (null? dy1301) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1297) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1297 y1298))) tmp1302))) (syntax-dispatch tmp1302 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) x1297)) tmp1300) ((lambda (tmp1306) (if tmp1306 (apply (lambda (stuff1307) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons x1297 stuff1307))) tmp1306) ((lambda (else1308) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1297 y1298)) tmp1299))) (syntax-dispatch tmp1299 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . any)))))) (syntax-dispatch tmp1299 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) y1298)) tmp1296) (syntax-error tmp1295))) (syntax-dispatch tmp1295 (quote (any any))))) (list x1293 y1294)))) (quasiappend1290 (lambda (x1309 y1310) ((lambda (tmp1311) ((lambda (tmp1312) (if tmp1312 (apply (lambda (x1313 y1314) ((lambda (tmp1315) ((lambda (tmp1316) (if tmp1316 (apply (lambda () x1313) tmp1316) ((lambda (_1317) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1313 y1314)) tmp1315))) (syntax-dispatch tmp1315 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) ()))))) y1314)) tmp1312) (syntax-error tmp1311))) (syntax-dispatch tmp1311 (quote (any any))))) (list x1309 y1310)))) (quasivector1291 (lambda (x1318) ((lambda (tmp1319) ((lambda (x1320) ((lambda (tmp1321) ((lambda (tmp1322) (if tmp1322 (apply (lambda (x1323) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (list->vector x1323))) tmp1322) ((lambda (tmp1325) (if tmp1325 (apply (lambda (x1326) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1326)) tmp1325) ((lambda (_1328) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1320)) tmp1321))) (syntax-dispatch tmp1321 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . each-any)))))) (syntax-dispatch tmp1321 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) each-any))))) x1320)) tmp1319)) x1318))) (quasi1292 (lambda (p1329 lev1330) ((lambda (tmp1331) ((lambda (tmp1332) (if tmp1332 (apply (lambda (p1333) (if (= lev1330 (quote 0)) p1333 (quasicons1289 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi1292 (list p1333) (- lev1330 (quote 1)))))) tmp1332) ((lambda (tmp1334) (if tmp1334 (apply (lambda (p1335 q1336) (if (= lev1330 (quote 0)) (quasiappend1290 p1335 (quasi1292 q1336 lev1330)) (quasicons1289 (quasicons1289 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi1292 (list p1335) (- lev1330 (quote 1)))) (quasi1292 q1336 lev1330)))) tmp1334) ((lambda (tmp1337) (if tmp1337 (apply (lambda (p1338) (quasicons1289 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi1292 (list p1338) (+ lev1330 (quote 1))))) tmp1337) ((lambda (tmp1339) (if tmp1339 (apply (lambda (p1340 q1341) (quasicons1289 (quasi1292 p1340 lev1330) (quasi1292 q1341 lev1330))) tmp1339) ((lambda (tmp1342) (if tmp1342 (apply (lambda (x1343) (quasivector1291 (quasi1292 x1343 lev1330))) tmp1342) ((lambda (p1345) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) p1345)) tmp1331))) (syntax-dispatch tmp1331 (quote #(vector each-any)))))) (syntax-dispatch tmp1331 (quote (any . any)))))) (syntax-dispatch tmp1331 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any)))))) (syntax-dispatch tmp1331 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any) . any)))))) (syntax-dispatch tmp1331 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) p1329)))) (lambda (x1346) ((lambda (tmp1347) ((lambda (tmp1348) (if tmp1348 (apply (lambda (_1349 e1350) (quasi1292 e1350 (quote 0))) tmp1348) (syntax-error tmp1347))) (syntax-dispatch tmp1347 (quote (any any))))) x1346)))) +(install-global-transformer (quote include) (lambda (x1351) (letrec ((read-file1352 (lambda (fn1353 k1354) (let ((p1355 (open-input-file fn1353))) (let f1356 ((x1357 (read p1355))) (if (eof-object? x1357) (begin (close-input-port p1355) (quote ())) (cons (datum->syntax-object k1354 x1357) (f1356 (read p1355))))))))) ((lambda (tmp1358) ((lambda (tmp1359) (if tmp1359 (apply (lambda (k1360 filename1361) (let ((fn1362 (syntax-object->datum filename1361))) ((lambda (tmp1363) ((lambda (tmp1364) (if tmp1364 (apply (lambda (exp1365) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))))) exp1365)) tmp1364) (syntax-error tmp1363))) (syntax-dispatch tmp1363 (quote each-any)))) (read-file1352 fn1362 k1360)))) tmp1359) (syntax-error tmp1358))) (syntax-dispatch tmp1358 (quote (any any))))) x1351)))) +(install-global-transformer (quote unquote) (lambda (x1367) ((lambda (tmp1368) ((lambda (tmp1369) (if tmp1369 (apply (lambda (_1370 e1371) (error (quote unquote) (quote "expression ,~s not valid outside of quasiquote") (syntax-object->datum e1371))) tmp1369) (syntax-error tmp1368))) (syntax-dispatch tmp1368 (quote (any any))))) x1367))) +(install-global-transformer (quote unquote-splicing) (lambda (x1372) ((lambda (tmp1373) ((lambda (tmp1374) (if tmp1374 (apply (lambda (_1375 e1376) (error (quote unquote-splicing) (quote "expression ,@~s not valid outside of quasiquote") (syntax-object->datum e1376))) tmp1374) (syntax-error tmp1373))) (syntax-dispatch tmp1373 (quote (any any))))) x1372))) +(install-global-transformer (quote case) (lambda (x1377) ((lambda (tmp1378) ((lambda (tmp1379) (if tmp1379 (apply (lambda (_1380 e1381 m11382 m21383) ((lambda (tmp1384) ((lambda (body1385) (list (quote #(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"))))) (list (list (quote #(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"))))) e1381)) body1385)) tmp1384)) (let f1386 ((clause1387 m11382) (clauses1388 m21383)) (if (null? clauses1388) ((lambda (tmp1390) ((lambda (tmp1391) (if tmp1391 (apply (lambda (e11392 e21393) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11392 e21393))) tmp1391) ((lambda (tmp1395) (if tmp1395 (apply (lambda (k1396 e11397 e21398) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) k1396)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11397 e21398)))) tmp1395) ((lambda (_1401) (syntax-error x1377)) tmp1390))) (syntax-dispatch tmp1390 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1390 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) any . each-any))))) clause1387) ((lambda (tmp1402) ((lambda (rest1403) ((lambda (tmp1404) ((lambda (tmp1405) (if tmp1405 (apply (lambda (k1406 e11407 e21408) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) k1406)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11407 e21408)) rest1403)) tmp1405) ((lambda (_1411) (syntax-error x1377)) tmp1404))) (syntax-dispatch tmp1404 (quote (each-any any . each-any))))) clause1387)) tmp1402)) (f1386 (car clauses1388) (cdr clauses1388))))))) tmp1379) (syntax-error tmp1378))) (syntax-dispatch tmp1378 (quote (any any any . each-any))))) x1377))) +(install-global-transformer (quote identifier-syntax) (lambda (x1412) ((lambda (tmp1413) ((lambda (tmp1414) (if tmp1414 (apply (lambda (_1415 e1416) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) e1416)) (list (cons _1415 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1416 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))))))))) tmp1414) (syntax-error tmp1413))) (syntax-dispatch tmp1413 (quote (any any))))) x1412)))