[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 6a952e0ee9
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 6a952e0ee9093424cdc8f300406d09ce195ebf5c |
|
Date: |
Wed, 29 Apr 2009 21:39:38 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6a952e0ee9093424cdc8f300406d09ce195ebf5c
The branch, syncase-in-boot-9 has been updated
via 6a952e0ee9093424cdc8f300406d09ce195ebf5c (commit)
via 4d24854111110b44a28a4d46242bac1285de387a (commit)
via 12eae603c76edc8affc0e8331df7f22a4d8a8b2c (commit)
from 3d5f3091e100550052abc698e980b3e86cc01b65 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 6a952e0ee9093424cdc8f300406d09ce195ebf5c
Author: Andy Wingo <address@hidden>
Date: Wed Apr 29 23:39:09 2009 +0200
more cleanups to boot-9/psyntax
* module/ice-9/boot-9.scm: Comment some more things.
* module/ice-9/psyntax.scm: Remove error-hook -- callers should just use
syntax-violation. Change all callers.
* module/ice-9/psyntax-pp.scm: Regenerated.
commit 4d24854111110b44a28a4d46242bac1285de387a
Author: Andy Wingo <address@hidden>
Date: Wed Apr 29 23:12:12 2009 +0200
remove andmap from public API (we still have and-map)
* module/ice-9/boot-9.scm (and-map, or-map): Move these definitions up so
psyntax can use them.
(andmap): Remove, yay.
* module/ice-9/psyntax.scm: Remove notes about andmap, and just use
Guile's and-map -- except in cases that need the multiple list support,
in which case we have a private and-map*.
* module/ice-9/psyntax-pp.scm: Regenerated.
commit 12eae603c76edc8affc0e8331df7f22a4d8a8b2c
Author: Andy Wingo <address@hidden>
Date: Wed Apr 29 22:50:45 2009 +0200
cleanups to boot-9
* module/ice-9/boot-9.scm: Shuffle around some definitions.
(module-add!): Removed stub definition, no longer used.
(install-global-transformer): Removed, no longer used (yay!).
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/ice-9/psyntax.scm: Remove install-global-transformer.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/boot-9.scm | 123 +++++++++++++++++++------------------------
module/ice-9/psyntax-pp.scm | 22 ++++----
module/ice-9/psyntax.scm | 113 ++++++++++++++++-----------------------
3 files changed, 111 insertions(+), 147 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index c12dc96..18c7160 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -95,6 +95,42 @@
(define (provided? feature)
(and (memq feature *features*) #t))
+
+
+;;; {and-map and or-map}
+;;;
+;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;;
+
+;; and-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or f returns #f.
+;; If returning early, return #f. Otherwise, return the last value returned
+;; by f. If f has never been called because l is empty, return #t.
+;;
+(define (and-map f lst)
+ (let loop ((result #t)
+ (l lst))
+ (and result
+ (or (and (null? l)
+ result)
+ (loop (f (car l)) (cdr l))))))
+
+;; or-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or while f returns #f.
+;; If returning early, return the return value of f.
+;;
+(define (or-map f lst)
+ (let loop ((result #f)
+ (l lst))
+ (or result
+ (and (not (null? l))
+ (loop (f (car l)) (cdr l))))))
+
+
+
;; let format alias simple-format until the more complete version is loaded
(define format simple-format)
@@ -134,12 +170,10 @@
-;; Before the module system boots, there are no module names. But
-;; psyntax does want a module-name definition, so give it one.
+;; Define a minimal stub of the module API for psyntax, before modules
+;; have booted.
(define (module-name x)
'(guile))
-(define (module-add! module sym var)
- (hashq-set! (%get-pre-modules-obarray) sym var))
(define (module-define! module sym val)
(let ((v (hashq-ref (%get-pre-modules-obarray) sym)))
(if v
@@ -149,7 +183,12 @@
(define (module-ref module sym)
(let ((v (module-variable module sym)))
(if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
+(define (resolve-module . args)
+ #f)
+;; Output hook for syncase. It's here because we want to be able to
+;; replace its definition, for compiling; but that isn't implemented
+;; yet.
(define (make-module-ref mod var kind)
(case kind
((public) (if mod `(@ ,mod ,var) var))
@@ -163,10 +202,13 @@
`(@@ ,mod ,var)
var))
(else (error "foo" mod var kind))))
-(define (resolve-module . args)
- #f)
-;;; API provided by psyntax
+;; Input hook to syncase -- so that we might be able to pass annotated
+;; expressions in. Currently disabled. Maybe we should just use
+;; source-properties directly.
+(define (annotation? x) #f)
+
+;; API provided by psyntax
(define syntax-violation #f)
(define datum->syntax #f)
(define syntax->datum #f)
@@ -177,44 +219,21 @@
(define sc-expand #f)
(define sc-expand3 #f)
-;;; Implementation detail of psyntax -- the thing that does expand-time
-;;; dispatch for syntax-case macros
+;; $sc-expand is an implementation detail of psyntax. It is used by
+;; expanded macros, to dispatch an input against a set of patterns.
(define $sc-dispatch #f)
-;;; Useless crap I'd like to get rid of
-(define install-global-transformer #f)
-(define (annotation? x) #f)
-
-
-(define andmap
- (lambda (f first . rest)
- (or (null? first)
- (if (null? rest)
- (let andmap ((first first))
- (let ((x (car first)) (first (cdr first)))
- (if (null? first)
- (f x)
- (and (f x) (andmap first)))))
- (let andmap ((first first) (rest rest))
- (let ((x (car first))
- (xr (map car rest))
- (first (cdr first))
- (rest (map cdr rest)))
- (if (null? first)
- (apply f (cons x xr))
- (and (apply f (cons x xr)) (andmap first rest)))))))))
-
+;; Load it up!
(primitive-load-path "ice-9/psyntax-pp")
-;; Until the module system is booted, this will be the current expander.
+;; %pre-modules-transformer is the Scheme expander from now until the
+;; module system has booted up.
(define %pre-modules-transformer sc-expand)
;;; {Defmacros}
;;;
-;;; Depends on: features, eval-case
-;;;
(define-syntax define-macro
(lambda (x)
@@ -507,40 +526,6 @@
-;;; {and-map and or-map}
-;;;
-;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
-;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
-;;;
-
-;; and-map f l
-;;
-;; Apply f to successive elements of l until exhaustion or f returns #f.
-;; If returning early, return #f. Otherwise, return the last value returned
-;; by f. If f has never been called because l is empty, return #t.
-;;
-(define (and-map f lst)
- (let loop ((result #t)
- (l lst))
- (and result
- (or (and (null? l)
- result)
- (loop (f (car l)) (cdr l))))))
-
-;; or-map f l
-;;
-;; Apply f to successive elements of l until exhaustion or while f returns #f.
-;; If returning early, return the return value of f.
-;;
-(define (or-map f lst)
- (let loop ((result #f)
- (l lst))
- (or result
- (and (not (null? l))
- (loop (f (car l)) (cdr l))))))
-
-
-
(if (provided? 'posix)
(primitive-load-path "ice-9/posix"))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 5cb5213..ba20427 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,13 +1,13 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(void)
-(letrec ((lambda-var-list1131 (lambda (vars1336) (let lvl1337 ((vars1338
vars1336) (ls1339 (quote ())) (w1340 (quote (())))) (cond ((pair? vars1338)
(lvl1337 (cdr vars1338) (cons (wrap1110 (car vars1338) w1340 #f) ls1339)
w1340)) ((id?1082 vars1338) (cons (wrap1110 vars1338 w1340 #f) ls1339)) ((null?
vars1338) ls1339) ((syntax-object?1066 vars1338) (lvl1337
(syntax-object-expression1067 vars1338) ls1339 (join-wraps1101 w1340
(syntax-object-wrap1068 vars1338)))) ((annotation? vars1338) (lvl1337
(annotation-expression vars1338) ls1339 w1340)) (else (cons vars1338
ls1339)))))) (gen-var1130 (lambda (id1341) (let ((id1342 (if
(syntax-object?1066 id1341) (syntax-object-expression1067 id1341) id1341))) (if
(annotation? id1342) (build-annotated1059 (annotation-source id1342) (gensym
(symbol->string (annotation-expression id1342)))) (build-annotated1059 #f
(gensym (symbol->string id1342))))))) (strip1129 (lambda (x1343 w1344) (if
(memq (quote top) (wrap-marks1085 w1344)) (if (or (annotation? x1343) (and
(pair? x1343) (annotation? (car x1343)))) (strip-annotation1128 x1343 #f)
x1343) (let f1345 ((x1346 x1343)) (cond ((syntax-object?1066 x1346) (strip1129
(syntax-object-expression1067 x1346) (syntax-object-wrap1068 x1346))) ((pair?
x1346) (let ((a1347 (f1345 (car x1346))) (d1348 (f1345 (cdr x1346)))) (if (and
(eq? a1347 (car x1346)) (eq? d1348 (cdr x1346))) x1346 (cons a1347 d1348))))
((vector? x1346) (let ((old1349 (vector->list x1346))) (let ((new1350 (map
f1345 old1349))) (if (andmap eq? old1349 new1350) x1346 (list->vector
new1350))))) (else x1346)))))) (strip-annotation1128 (lambda (x1351 parent1352)
(cond ((pair? x1351) (let ((new1353 (cons #f #f))) (begin (if parent1352
(set-annotation-stripped! parent1352 new1353)) (set-car! new1353
(strip-annotation1128 (car x1351) #f)) (set-cdr! new1353 (strip-annotation1128
(cdr x1351) #f)) new1353))) ((annotation? x1351) (or (annotation-stripped
x1351) (strip-annotation1128 (annotation-expression x1351) x1351))) ((vector?
x1351) (let ((new1354 (make-vector (vector-length x1351)))) (begin (if
parent1352 (set-annotation-stripped! parent1352 new1354)) (let loop1355 ((i1356
(- (vector-length x1351) 1))) (unless (fx<1053 i1356 0) (vector-set! new1354
i1356 (strip-annotation1128 (vector-ref x1351 i1356) #f)) (loop1355 (fx-1051
i1356 1)))) new1354))) (else x1351)))) (ellipsis?1127 (lambda (x1357) (and
(nonsymbol-id?1081 x1357) (free-id=?1105 x1357 (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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))))))
(chi-void1126 (lambda () (build-annotated1059 #f (list (build-annotated1059 #f
(quote void)))))) (eval-local-transformer1125 (lambda (expanded1358 mod1359)
(let ((p1360 (local-eval-hook1055 expanded1358 mod1359))) (if (procedure?
p1360) p1360 (syntax-violation #f "nonprocedure transformer" p1360)))))
(chi-local-syntax1124 (lambda (rec?1361 e1362 r1363 w1364 s1365 mod1366 k1367)
((lambda (tmp1368) ((lambda (tmp1369) (if tmp1369 (apply (lambda (_1370 id1371
val1372 e11373 e21374) (let ((ids1375 id1371)) (if (not (valid-bound-ids?1107
ids1375)) (syntax-violation #f "duplicate bound keyword" e1362) (let
((labels1377 (gen-labels1088 ids1375))) (let ((new-w1378 (make-binding-wrap1099
ids1375 labels1377 w1364))) (k1367 (cons e11373 e21374) (extend-env1076
labels1377 (let ((w1380 (if rec?1361 new-w1378 w1364)) (trans-r1381
(macros-only-env1078 r1363))) (map (lambda (x1382) (cons (quote macro)
(eval-local-transformer1125 (chi1118 x1382 trans-r1381 w1380 mod1366)
mod1366))) val1372)) r1363) new-w1378 s1365 mod1366)))))) tmp1369) ((lambda
(_1384) (syntax-violation #f "bad local syntax definition" (source-wrap1111
e1362 w1364 s1365 mod1366))) tmp1368))) ($sc-dispatch tmp1368 (quote (any
#(each (any any)) any . each-any))))) e1362))) (chi-lambda-clause1123 (lambda
(e1385 docstring1386 c1387 r1388 w1389 mod1390 k1391) ((lambda (tmp1392)
((lambda (tmp1393) (if (if tmp1393 (apply (lambda (args1394 doc1395 e11396
e21397) (and (string? (syntax->datum doc1395)) (not docstring1386))) tmp1393)
#f) (apply (lambda (args1398 doc1399 e11400 e21401) (chi-lambda-clause1123
e1385 doc1399 (cons args1398 (cons e11400 e21401)) r1388 w1389 mod1390 k1391))
tmp1393) ((lambda (tmp1403) (if tmp1403 (apply (lambda (id1404 e11405 e21406)
(let ((ids1407 id1404)) (if (not (valid-bound-ids?1107 ids1407))
(syntax-violation (quote lambda) "invalid parameter list" e1385) (let
((labels1409 (gen-labels1088 ids1407)) (new-vars1410 (map gen-var1130
ids1407))) (k1391 new-vars1410 docstring1386 (chi-body1122 (cons e11405 e21406)
e1385 (extend-var-env1077 labels1409 new-vars1410 r1388) (make-binding-wrap1099
ids1407 labels1409 w1389) mod1390)))))) tmp1403) ((lambda (tmp1412) (if tmp1412
(apply (lambda (ids1413 e11414 e21415) (let ((old-ids1416 (lambda-var-list1131
ids1413))) (if (not (valid-bound-ids?1107 old-ids1416)) (syntax-violation
(quote lambda) "invalid parameter list" e1385) (let ((labels1417
(gen-labels1088 old-ids1416)) (new-vars1418 (map gen-var1130 old-ids1416)))
(k1391 (let f1419 ((ls11420 (cdr new-vars1418)) (ls21421 (car new-vars1418)))
(if (null? ls11420) ls21421 (f1419 (cdr ls11420) (cons (car ls11420)
ls21421)))) docstring1386 (chi-body1122 (cons e11414 e21415) e1385
(extend-var-env1077 labels1417 new-vars1418 r1388) (make-binding-wrap1099
old-ids1416 labels1417 w1389) mod1390)))))) tmp1412) ((lambda (_1423)
(syntax-violation (quote lambda) "bad lambda" e1385)) tmp1392))) ($sc-dispatch
tmp1392 (quote (any any . each-any)))))) ($sc-dispatch tmp1392 (quote (each-any
any . each-any)))))) ($sc-dispatch tmp1392 (quote (any any any . each-any)))))
c1387))) (chi-body1122 (lambda (body1424 outer-form1425 r1426 w1427 mod1428)
(let ((r1429 (cons (quote ("placeholder" placeholder)) r1426))) (let
((ribcage1430 (make-ribcage1089 (quote ()) (quote ()) (quote ())))) (let
((w1431 (make-wrap1084 (wrap-marks1085 w1427) (cons ribcage1430 (wrap-subst1086
w1427))))) (let parse1432 ((body1433 (map (lambda (x1439) (cons r1429 (wrap1110
x1439 w1431 mod1428))) body1424)) (ids1434 (quote ())) (labels1435 (quote ()))
(vars1436 (quote ())) (vals1437 (quote ())) (bindings1438 (quote ()))) (if
(null? body1433) (syntax-violation #f "no expressions in body" outer-form1425)
(let ((e1440 (cdar body1433)) (er1441 (caar body1433))) (call-with-values
(lambda () (syntax-type1116 e1440 er1441 (quote (())) #f ribcage1430 mod1428))
(lambda (type1442 value1443 e1444 w1445 s1446 mod1447) (let ((t1448 type1442))
(if (memv t1448 (quote (define-form))) (let ((id1449 (wrap1110 value1443 w1445
mod1447)) (label1450 (gen-label1087))) (let ((var1451 (gen-var1130 id1449)))
(begin (extend-ribcage!1098 ribcage1430 id1449 label1450) (parse1432 (cdr
body1433) (cons id1449 ids1434) (cons label1450 labels1435) (cons var1451
vars1436) (cons (cons er1441 (wrap1110 e1444 w1445 mod1447)) vals1437) (cons
(cons (quote lexical) var1451) bindings1438))))) (if (memv t1448 (quote
(define-syntax-form))) (let ((id1452 (wrap1110 value1443 w1445 mod1447))
(label1453 (gen-label1087))) (begin (extend-ribcage!1098 ribcage1430 id1452
label1453) (parse1432 (cdr body1433) (cons id1452 ids1434) (cons label1453
labels1435) vars1436 vals1437 (cons (cons (quote macro) (cons er1441 (wrap1110
e1444 w1445 mod1447))) bindings1438)))) (if (memv t1448 (quote (begin-form)))
((lambda (tmp1454) ((lambda (tmp1455) (if tmp1455 (apply (lambda (_1456 e11457)
(parse1432 (let f1458 ((forms1459 e11457)) (if (null? forms1459) (cdr body1433)
(cons (cons er1441 (wrap1110 (car forms1459) w1445 mod1447)) (f1458 (cdr
forms1459))))) ids1434 labels1435 vars1436 vals1437 bindings1438)) tmp1455)
(syntax-violation #f "source expression failed to match any pattern" tmp1454)))
($sc-dispatch tmp1454 (quote (any . each-any))))) e1444) (if (memv t1448 (quote
(local-syntax-form))) (chi-local-syntax1124 value1443 e1444 er1441 w1445 s1446
mod1447 (lambda (forms1461 er1462 w1463 s1464 mod1465) (parse1432 (let f1466
((forms1467 forms1461)) (if (null? forms1467) (cdr body1433) (cons (cons er1462
(wrap1110 (car forms1467) w1463 mod1465)) (f1466 (cdr forms1467))))) ids1434
labels1435 vars1436 vals1437 bindings1438))) (if (null? ids1434)
(build-sequence1061 #f (map (lambda (x1468) (chi1118 (cdr x1468) (car x1468)
(quote (())) mod1447)) (cons (cons er1441 (source-wrap1111 e1444 w1445 s1446
mod1447)) (cdr body1433)))) (begin (if (not (valid-bound-ids?1107 ids1434))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form1425)) (let loop1469 ((bs1470 bindings1438) (er-cache1471 #f)
(r-cache1472 #f)) (if (not (null? bs1470)) (let ((b1473 (car bs1470))) (if (eq?
(car b1473) (quote macro)) (let ((er1474 (cadr b1473))) (let ((r-cache1475 (if
(eq? er1474 er-cache1471) r-cache1472 (macros-only-env1078 er1474)))) (begin
(set-cdr! b1473 (eval-local-transformer1125 (chi1118 (cddr b1473) r-cache1475
(quote (())) mod1447) mod1447)) (loop1469 (cdr bs1470) er1474 r-cache1475))))
(loop1469 (cdr bs1470) er-cache1471 r-cache1472))))) (set-cdr! r1429
(extend-env1076 labels1435 bindings1438 (cdr r1429))) (build-letrec1064 #f
vars1436 (map (lambda (x1476) (chi1118 (cdr x1476) (car x1476) (quote (()))
mod1447)) vals1437) (build-sequence1061 #f (map (lambda (x1477) (chi1118 (cdr
x1477) (car x1477) (quote (())) mod1447)) (cons (cons er1441 (source-wrap1111
e1444 w1445 s1446 mod1447)) (cdr body1433)))))))))))))))))))))) (chi-macro1121
(lambda (p1478 e1479 r1480 w1481 rib1482 mod1483) (letrec
((rebuild-macro-output1484 (lambda (x1485 m1486) (cond ((pair? x1485) (cons
(rebuild-macro-output1484 (car x1485) m1486) (rebuild-macro-output1484 (cdr
x1485) m1486))) ((syntax-object?1066 x1485) (let ((w1487
(syntax-object-wrap1068 x1485))) (let ((ms1488 (wrap-marks1085 w1487)) (s1489
(wrap-subst1086 w1487))) (if (and (pair? ms1488) (eq? (car ms1488) #f))
(make-syntax-object1065 (syntax-object-expression1067 x1485) (make-wrap1084
(cdr ms1488) (if rib1482 (cons rib1482 (cdr s1489)) (cdr s1489)))
(syntax-object-module1069 x1485)) (make-syntax-object1065
(syntax-object-expression1067 x1485) (make-wrap1084 (cons m1486 ms1488) (if
rib1482 (cons rib1482 (cons (quote shift) s1489)) (cons (quote shift) s1489)))
(let ((pmod1490 (procedure-module p1478))) (if pmod1490 (cons (quote hygiene)
(module-name pmod1490)) (quote (hygiene guile))))))))) ((vector? x1485) (let
((n1491 (vector-length x1485))) (let ((v1492 (make-vector n1491))) (let
doloop1493 ((i1494 0)) (if (fx=1052 i1494 n1491) v1492 (begin (vector-set!
v1492 i1494 (rebuild-macro-output1484 (vector-ref x1485 i1494) m1486))
(doloop1493 (fx+1050 i1494 1)))))))) ((symbol? x1485) (syntax-violation #f
"encountered raw symbol in macro output" (source-wrap1111 e1479 w1481 s
mod1483) x1485)) (else x1485))))) (rebuild-macro-output1484 (p1478 (wrap1110
e1479 (anti-mark1097 w1481) mod1483)) (string #\m))))) (chi-application1120
(lambda (x1495 e1496 r1497 w1498 s1499 mod1500) ((lambda (tmp1501) ((lambda
(tmp1502) (if tmp1502 (apply (lambda (e01503 e11504) (build-annotated1059 s1499
(cons x1495 (map (lambda (e1505) (chi1118 e1505 r1497 w1498 mod1500))
e11504)))) tmp1502) (syntax-violation #f "source expression failed to match any
pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any . each-any))))) e1496)))
(chi-expr1119 (lambda (type1507 value1508 e1509 r1510 w1511 s1512 mod1513) (let
((t1514 type1507)) (if (memv t1514 (quote (lexical))) (build-annotated1059
s1512 value1508) (if (memv t1514 (quote (core external-macro))) (value1508
e1509 r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (module-ref)))
(call-with-values (lambda () (value1508 e1509)) (lambda (id1515 mod1516)
(build-annotated1059 s1512 (if mod1516 (make-module-ref (cdr mod1516) id1515
(car mod1516)) (make-module-ref mod1516 id1515 (quote bare)))))) (if (memv
t1514 (quote (lexical-call))) (chi-application1120 (build-annotated1059
(source-annotation1073 (car e1509)) value1508) e1509 r1510 w1511 s1512 mod1513)
(if (memv t1514 (quote (global-call))) (chi-application1120
(build-annotated1059 (source-annotation1073 (car e1509)) (if (if
(syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509))
mod1513) (make-module-ref (cdr (if (syntax-object?1066 (car e1509))
(syntax-object-module1069 (car e1509)) mod1513)) value1508 (car (if
(syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509))
mod1513))) (make-module-ref (if (syntax-object?1066 (car e1509))
(syntax-object-module1069 (car e1509)) mod1513) value1508 (quote bare)))) e1509
r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (constant))) (build-data1060
s1512 (strip1129 (source-wrap1111 e1509 w1511 s1512 mod1513) (quote (())))) (if
(memv t1514 (quote (global))) (build-annotated1059 s1512 (if mod1513
(make-module-ref (cdr mod1513) value1508 (car mod1513)) (make-module-ref
mod1513 value1508 (quote bare)))) (if (memv t1514 (quote (call)))
(chi-application1120 (chi1118 (car e1509) r1510 w1511 mod1513) e1509 r1510
w1511 s1512 mod1513) (if (memv t1514 (quote (begin-form))) ((lambda (tmp1517)
((lambda (tmp1518) (if tmp1518 (apply (lambda (_1519 e11520 e21521)
(chi-sequence1112 (cons e11520 e21521) r1510 w1511 s1512 mod1513)) tmp1518)
(syntax-violation #f "source expression failed to match any pattern" tmp1517)))
($sc-dispatch tmp1517 (quote (any any . each-any))))) e1509) (if (memv t1514
(quote (local-syntax-form))) (chi-local-syntax1124 value1508 e1509 r1510 w1511
s1512 mod1513 chi-sequence1112) (if (memv t1514 (quote (eval-when-form)))
((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (_1525 x1526
e11527 e21528) (let ((when-list1529 (chi-when-list1115 e1509 x1526 w1511))) (if
(memq (quote eval) when-list1529) (chi-sequence1112 (cons e11527 e21528) r1510
w1511 s1512 mod1513) (chi-void1126)))) tmp1524) (syntax-violation #f "source
expression failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote
(any each-any any . each-any))))) e1509) (if (memv t1514 (quote (define-form
define-syntax-form))) (syntax-violation #f "definition in expression context"
e1509 (wrap1110 value1508 w1511 mod1513)) (if (memv t1514 (quote (syntax)))
(syntax-violation #f "reference to pattern variable outside syntax form"
(source-wrap1111 e1509 w1511 s1512 mod1513)) (if (memv t1514 (quote
(displaced-lexical))) (syntax-violation #f "reference to identifier outside its
scope" (source-wrap1111 e1509 w1511 s1512 mod1513)) (syntax-violation #f
"unexpected syntax" (source-wrap1111 e1509 w1511 s1512
mod1513))))))))))))))))))) (chi1118 (lambda (e1532 r1533 w1534 mod1535)
(call-with-values (lambda () (syntax-type1116 e1532 r1533 w1534 #f #f mod1535))
(lambda (type1536 value1537 e1538 w1539 s1540 mod1541) (chi-expr1119 type1536
value1537 e1538 r1533 w1539 s1540 mod1541))))) (chi-top1117 (lambda (e1542
r1543 w1544 m1545 esew1546 mod1547) (call-with-values (lambda ()
(syntax-type1116 e1542 r1543 w1544 #f #f mod1547)) (lambda (type1555 value1556
e1557 w1558 s1559 mod1560) (let ((t1561 type1555)) (if (memv t1561 (quote
(begin-form))) ((lambda (tmp1562) ((lambda (tmp1563) (if tmp1563 (apply (lambda
(_1564) (chi-void1126)) tmp1563) ((lambda (tmp1565) (if tmp1565 (apply (lambda
(_1566 e11567 e21568) (chi-top-sequence1113 (cons e11567 e21568) r1543 w1558
s1559 m1545 esew1546 mod1560)) tmp1565) (syntax-violation #f "source expression
failed to match any pattern" tmp1562))) ($sc-dispatch tmp1562 (quote (any any .
each-any)))))) ($sc-dispatch tmp1562 (quote (any))))) e1557) (if (memv t1561
(quote (local-syntax-form))) (chi-local-syntax1124 value1556 e1557 r1543 w1558
s1559 mod1560 (lambda (body1570 r1571 w1572 s1573 mod1574)
(chi-top-sequence1113 body1570 r1571 w1572 s1573 m1545 esew1546 mod1574))) (if
(memv t1561 (quote (eval-when-form))) ((lambda (tmp1575) ((lambda (tmp1576) (if
tmp1576 (apply (lambda (_1577 x1578 e11579 e21580) (let ((when-list1581
(chi-when-list1115 e1557 x1578 w1558)) (body1582 (cons e11579 e21580))) (cond
((eq? m1545 (quote e)) (if (memq (quote eval) when-list1581)
(chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote e) (quote (eval))
mod1560) (chi-void1126))) ((memq (quote load) when-list1581) (if (or (memq
(quote compile) when-list1581) (and (eq? m1545 (quote c&e)) (memq (quote eval)
when-list1581))) (chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote c&e)
(quote (compile load)) mod1560) (if (memq m1545 (quote (c c&e)))
(chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote c) (quote (load))
mod1560) (chi-void1126)))) ((or (memq (quote compile) when-list1581) (and (eq?
m1545 (quote c&e)) (memq (quote eval) when-list1581))) (top-level-eval-hook1054
(chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote e) (quote (eval))
mod1560) mod1560) (chi-void1126)) (else (chi-void1126))))) tmp1576)
(syntax-violation #f "source expression failed to match any pattern" tmp1575)))
($sc-dispatch tmp1575 (quote (any each-any any . each-any))))) e1557) (if (memv
t1561 (quote (define-syntax-form))) (let ((n1585 (id-var-name1104 value1556
w1558)) (r1586 (macros-only-env1078 r1543))) (let ((t1587 m1545)) (if (memv
t1587 (quote (c))) (if (memq (quote compile) esew1546) (let ((e1588
(chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)))) (begin
(top-level-eval-hook1054 e1588 mod1560) (if (memq (quote load) esew1546) e1588
(chi-void1126)))) (if (memq (quote load) esew1546) (chi-install-global1114
n1585 (chi1118 e1557 r1586 w1558 mod1560)) (chi-void1126))) (if (memv t1587
(quote (c&e))) (let ((e1589 (chi-install-global1114 n1585 (chi1118 e1557 r1586
w1558 mod1560)))) (begin (top-level-eval-hook1054 e1589 mod1560) e1589)) (begin
(if (memq (quote eval) esew1546) (top-level-eval-hook1054
(chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)) mod1560))
(chi-void1126)))))) (if (memv t1561 (quote (define-form))) (let ((n1590
(id-var-name1104 value1556 w1558))) (let ((type1591 (binding-type1074
(lookup1079 n1590 r1543 mod1560)))) (let ((t1592 type1591)) (if (memv t1592
(quote (global core macro module-ref))) (let ((x1593 (build-annotated1059 s1559
(list (quote define) n1590 (chi1118 e1557 r1543 w1558 mod1560))))) (begin (if
(eq? m1545 (quote c&e)) (top-level-eval-hook1054 x1593 mod1560)) x1593)) (if
(memv t1592 (quote (displaced-lexical))) (syntax-violation #f "identifier out
of context" e1557 (wrap1110 value1556 w1558 mod1560)) (syntax-violation #f
"cannot define keyword at top level" e1557 (wrap1110 value1556 w1558
mod1560))))))) (let ((x1594 (chi-expr1119 type1555 value1556 e1557 r1543 w1558
s1559 mod1560))) (begin (if (eq? m1545 (quote c&e)) (top-level-eval-hook1054
x1594 mod1560)) x1594)))))))))))) (syntax-type1116 (lambda (e1595 r1596 w1597
s1598 rib1599 mod1600) (cond ((symbol? e1595) (let ((n1601 (id-var-name1104
e1595 w1597))) (let ((b1602 (lookup1079 n1601 r1596 mod1600))) (let ((type1603
(binding-type1074 b1602))) (let ((t1604 type1603)) (if (memv t1604 (quote
(lexical))) (values type1603 (binding-value1075 b1602) e1595 w1597 s1598
mod1600) (if (memv t1604 (quote (global))) (values type1603 n1601 e1595 w1597
s1598 mod1600) (if (memv t1604 (quote (macro))) (syntax-type1116 (chi-macro1121
(binding-value1075 b1602) e1595 r1596 w1597 rib1599 mod1600) r1596 (quote (()))
s1598 rib1599 mod1600) (values type1603 (binding-value1075 b1602) e1595 w1597
s1598 mod1600))))))))) ((pair? e1595) (let ((first1605 (car e1595))) (if
(id?1082 first1605) (let ((n1606 (id-var-name1104 first1605 w1597))) (let
((b1607 (lookup1079 n1606 r1596 (or (and (syntax-object?1066 first1605)
(syntax-object-module1069 first1605)) mod1600)))) (let ((type1608
(binding-type1074 b1607))) (let ((t1609 type1608)) (if (memv t1609 (quote
(lexical))) (values (quote lexical-call) (binding-value1075 b1607) e1595 w1597
s1598 mod1600) (if (memv t1609 (quote (global))) (values (quote global-call)
n1606 e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (macro)))
(syntax-type1116 (chi-macro1121 (binding-value1075 b1607) e1595 r1596 w1597
rib1599 mod1600) r1596 (quote (())) s1598 rib1599 mod1600) (if (memv t1609
(quote (core external-macro module-ref))) (values type1608 (binding-value1075
b1607) e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (local-syntax)))
(values (quote local-syntax-form) (binding-value1075 b1607) e1595 w1597 s1598
mod1600) (if (memv t1609 (quote (begin))) (values (quote begin-form) #f e1595
w1597 s1598 mod1600) (if (memv t1609 (quote (eval-when))) (values (quote
eval-when-form) #f e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (define)))
((lambda (tmp1610) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612
name1613 val1614) (id?1082 name1613)) tmp1611) #f) (apply (lambda (_1615
name1616 val1617) (values (quote define-form) name1616 val1617 w1597 s1598
mod1600)) tmp1611) ((lambda (tmp1618) (if (if tmp1618 (apply (lambda (_1619
name1620 args1621 e11622 e21623) (and (id?1082 name1620) (valid-bound-ids?1107
(lambda-var-list1131 args1621)))) tmp1618) #f) (apply (lambda (_1624 name1625
args1626 e11627 e21628) (values (quote define-form) (wrap1110 name1625 w1597
mod1600) (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 mod) #((top) (top) (top) (top) (top) (top)) #("i"
"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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1110 (cons
args1626 (cons e11627 e21628)) w1597 mod1600)) (quote (())) s1598 mod1600))
tmp1618) ((lambda (tmp1630) (if (if tmp1630 (apply (lambda (_1631 name1632)
(id?1082 name1632)) tmp1630) #f) (apply (lambda (_1633 name1634) (values (quote
define-form) (wrap1110 name1634 w1597 mod1600) (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 mod) #((top) (top) (top) (top) (top) (top)) #("i"
"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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (()))
s1598 mod1600)) tmp1630) (syntax-violation #f "source expression failed to
match any pattern" tmp1610))) ($sc-dispatch tmp1610 (quote (any any))))))
($sc-dispatch tmp1610 (quote (any (any . any) any . each-any))))))
($sc-dispatch tmp1610 (quote (any any any))))) e1595) (if (memv t1609 (quote
(define-syntax))) ((lambda (tmp1635) ((lambda (tmp1636) (if (if tmp1636 (apply
(lambda (_1637 name1638 val1639) (id?1082 name1638)) tmp1636) #f) (apply
(lambda (_1640 name1641 val1642) (values (quote define-syntax-form) name1641
val1642 w1597 s1598 mod1600)) tmp1636) (syntax-violation #f "source expression
failed to match any pattern" tmp1635))) ($sc-dispatch tmp1635 (quote (any any
any))))) e1595) (values (quote call) #f e1595 w1597 s1598 mod1600))))))))))))))
(values (quote call) #f e1595 w1597 s1598 mod1600)))) ((syntax-object?1066
e1595) (syntax-type1116 (syntax-object-expression1067 e1595) r1596
(join-wraps1101 w1597 (syntax-object-wrap1068 e1595)) #f rib1599 (or
(syntax-object-module1069 e1595) mod1600))) ((annotation? e1595)
(syntax-type1116 (annotation-expression e1595) r1596 w1597 (annotation-source
e1595) rib1599 mod1600)) ((self-evaluating? e1595) (values (quote constant) #f
e1595 w1597 s1598 mod1600)) (else (values (quote other) #f e1595 w1597 s1598
mod1600))))) (chi-when-list1115 (lambda (e1643 when-list1644 w1645) (let f1646
((when-list1647 when-list1644) (situations1648 (quote ()))) (if (null?
when-list1647) situations1648 (f1646 (cdr when-list1647) (cons (let ((x1649
(car when-list1647))) (cond ((free-id=?1105 x1649 (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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote
compile)) ((free-id=?1105 x1649 (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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load))
((free-id=?1105 x1649 (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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval))
(else (syntax-violation (quote eval-when) "invalid situation" e1643 (wrap1110
x1649 w1645 #f))))) situations1648)))))) (chi-install-global1114 (lambda
(name1650 e1651) (build-annotated1059 #f (list (build-annotated1059 #f (quote
define)) name1650 (if (let ((v1652 (module-variable (current-module)
name1650))) (and v1652 (variable-bound? v1652) (macro? (variable-ref v1652))
(not (eq? (macro-type (variable-ref v1652)) (quote syncase-macro)))))
(build-annotated1059 #f (list (build-annotated1059 #f (quote
make-extended-syncase-macro)) (build-annotated1059 #f (list
(build-annotated1059 #f (quote module-ref)) (build-annotated1059 #f (quote
(current-module))) (build-data1060 #f name1650))) (build-data1060 #f (quote
macro)) e1651)) (build-annotated1059 #f (list (build-annotated1059 #f (quote
make-syncase-macro)) (build-data1060 #f (quote macro)) e1651)))))))
(chi-top-sequence1113 (lambda (body1653 r1654 w1655 s1656 m1657 esew1658
mod1659) (build-sequence1061 s1656 (let dobody1660 ((body1661 body1653) (r1662
r1654) (w1663 w1655) (m1664 m1657) (esew1665 esew1658) (mod1666 mod1659)) (if
(null? body1661) (quote ()) (let ((first1667 (chi-top1117 (car body1661) r1662
w1663 m1664 esew1665 mod1666))) (cons first1667 (dobody1660 (cdr body1661)
r1662 w1663 m1664 esew1665 mod1666)))))))) (chi-sequence1112 (lambda (body1668
r1669 w1670 s1671 mod1672) (build-sequence1061 s1671 (let dobody1673 ((body1674
body1668) (r1675 r1669) (w1676 w1670) (mod1677 mod1672)) (if (null? body1674)
(quote ()) (let ((first1678 (chi1118 (car body1674) r1675 w1676 mod1677)))
(cons first1678 (dobody1673 (cdr body1674) r1675 w1676 mod1677))))))))
(source-wrap1111 (lambda (x1679 w1680 s1681 defmod1682) (wrap1110 (if s1681
(make-annotation x1679 s1681 #f) x1679) w1680 defmod1682))) (wrap1110 (lambda
(x1683 w1684 defmod1685) (cond ((and (null? (wrap-marks1085 w1684)) (null?
(wrap-subst1086 w1684))) x1683) ((syntax-object?1066 x1683)
(make-syntax-object1065 (syntax-object-expression1067 x1683) (join-wraps1101
w1684 (syntax-object-wrap1068 x1683)) (syntax-object-module1069 x1683)))
((null? x1683) x1683) (else (make-syntax-object1065 x1683 w1684 defmod1685)))))
(bound-id-member?1109 (lambda (x1686 list1687) (and (not (null? list1687)) (or
(bound-id=?1106 x1686 (car list1687)) (bound-id-member?1109 x1686 (cdr
list1687)))))) (distinct-bound-ids?1108 (lambda (ids1688) (let distinct?1689
((ids1690 ids1688)) (or (null? ids1690) (and (not (bound-id-member?1109 (car
ids1690) (cdr ids1690))) (distinct?1689 (cdr ids1690)))))))
(valid-bound-ids?1107 (lambda (ids1691) (and (let all-ids?1692 ((ids1693
ids1691)) (or (null? ids1693) (and (id?1082 (car ids1693)) (all-ids?1692 (cdr
ids1693))))) (distinct-bound-ids?1108 ids1691)))) (bound-id=?1106 (lambda
(i1694 j1695) (if (and (syntax-object?1066 i1694) (syntax-object?1066 j1695))
(and (eq? (let ((e1696 (syntax-object-expression1067 i1694))) (if (annotation?
e1696) (annotation-expression e1696) e1696)) (let ((e1697
(syntax-object-expression1067 j1695))) (if (annotation? e1697)
(annotation-expression e1697) e1697))) (same-marks?1103 (wrap-marks1085
(syntax-object-wrap1068 i1694)) (wrap-marks1085 (syntax-object-wrap1068
j1695)))) (eq? (let ((e1698 i1694)) (if (annotation? e1698)
(annotation-expression e1698) e1698)) (let ((e1699 j1695)) (if (annotation?
e1699) (annotation-expression e1699) e1699)))))) (free-id=?1105 (lambda (i1700
j1701) (and (eq? (let ((x1702 i1700)) (let ((e1703 (if (syntax-object?1066
x1702) (syntax-object-expression1067 x1702) x1702))) (if (annotation? e1703)
(annotation-expression e1703) e1703))) (let ((x1704 j1701)) (let ((e1705 (if
(syntax-object?1066 x1704) (syntax-object-expression1067 x1704) x1704))) (if
(annotation? e1705) (annotation-expression e1705) e1705)))) (eq?
(id-var-name1104 i1700 (quote (()))) (id-var-name1104 j1701 (quote (())))))))
(id-var-name1104 (lambda (id1706 w1707) (letrec ((search-vector-rib1710 (lambda
(sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let ((n1721
(vector-length symnames1719))) (let f1722 ((i1723 0)) (cond ((fx=1052 i1723
n1721) (search1708 sym1716 (cdr subst1717) marks1718)) ((and (eq? (vector-ref
symnames1719 i1723) sym1716) (same-marks?1103 marks1718 (vector-ref
(ribcage-marks1092 ribcage1720) i1723))) (values (vector-ref
(ribcage-labels1093 ribcage1720) i1723) marks1718)) (else (f1722 (fx+1050 i1723
1)))))))) (search-list-rib1709 (lambda (sym1724 subst1725 marks1726
symnames1727 ribcage1728) (let f1729 ((symnames1730 symnames1727) (i1731 0))
(cond ((null? symnames1730) (search1708 sym1724 (cdr subst1725) marks1726))
((and (eq? (car symnames1730) sym1724) (same-marks?1103 marks1726 (list-ref
(ribcage-marks1092 ribcage1728) i1731))) (values (list-ref (ribcage-labels1093
ribcage1728) i1731) marks1726)) (else (f1729 (cdr symnames1730) (fx+1050 i1731
1))))))) (search1708 (lambda (sym1732 subst1733 marks1734) (if (null?
subst1733) (values #f marks1734) (let ((fst1735 (car subst1733))) (if (eq?
fst1735 (quote shift)) (search1708 sym1732 (cdr subst1733) (cdr marks1734))
(let ((symnames1736 (ribcage-symnames1091 fst1735))) (if (vector? symnames1736)
(search-vector-rib1710 sym1732 subst1733 marks1734 symnames1736 fst1735)
(search-list-rib1709 sym1732 subst1733 marks1734 symnames1736 fst1735)))))))))
(cond ((symbol? id1706) (or (call-with-values (lambda () (search1708 id1706
(wrap-subst1086 w1707) (wrap-marks1085 w1707))) (lambda (x1738 . ignore1737)
x1738)) id1706)) ((syntax-object?1066 id1706) (let ((id1739 (let ((e1741
(syntax-object-expression1067 id1706))) (if (annotation? e1741)
(annotation-expression e1741) e1741))) (w11740 (syntax-object-wrap1068
id1706))) (let ((marks1742 (join-marks1102 (wrap-marks1085 w1707)
(wrap-marks1085 w11740)))) (call-with-values (lambda () (search1708 id1739
(wrap-subst1086 w1707) marks1742)) (lambda (new-id1743 marks1744) (or
new-id1743 (call-with-values (lambda () (search1708 id1739 (wrap-subst1086
w11740) marks1744)) (lambda (x1746 . ignore1745) x1746)) id1739))))))
((annotation? id1706) (let ((id1747 (let ((e1748 id1706)) (if (annotation?
e1748) (annotation-expression e1748) e1748)))) (or (call-with-values (lambda ()
(search1708 id1747 (wrap-subst1086 w1707) (wrap-marks1085 w1707))) (lambda
(x1750 . ignore1749) x1750)) id1747))) (else (error-hook1056 (quote
id-var-name) "invalid id" id1706)))))) (same-marks?1103 (lambda (x1751 y1752)
(or (eq? x1751 y1752) (and (not (null? x1751)) (not (null? y1752)) (eq? (car
x1751) (car y1752)) (same-marks?1103 (cdr x1751) (cdr y1752))))))
(join-marks1102 (lambda (m11753 m21754) (smart-append1100 m11753 m21754)))
(join-wraps1101 (lambda (w11755 w21756) (let ((m11757 (wrap-marks1085 w11755))
(s11758 (wrap-subst1086 w11755))) (if (null? m11757) (if (null? s11758) w21756
(make-wrap1084 (wrap-marks1085 w21756) (smart-append1100 s11758 (wrap-subst1086
w21756)))) (make-wrap1084 (smart-append1100 m11757 (wrap-marks1085 w21756))
(smart-append1100 s11758 (wrap-subst1086 w21756))))))) (smart-append1100
(lambda (m11759 m21760) (if (null? m21760) m11759 (append m11759 m21760))))
(make-binding-wrap1099 (lambda (ids1761 labels1762 w1763) (if (null? ids1761)
w1763 (make-wrap1084 (wrap-marks1085 w1763) (cons (let ((labelvec1764
(list->vector labels1762))) (let ((n1765 (vector-length labelvec1764))) (let
((symnamevec1766 (make-vector n1765)) (marksvec1767 (make-vector n1765)))
(begin (let f1768 ((ids1769 ids1761) (i1770 0)) (if (not (null? ids1769))
(call-with-values (lambda () (id-sym-name&marks1083 (car ids1769) w1763))
(lambda (symname1771 marks1772) (begin (vector-set! symnamevec1766 i1770
symname1771) (vector-set! marksvec1767 i1770 marks1772) (f1768 (cdr ids1769)
(fx+1050 i1770 1))))))) (make-ribcage1089 symnamevec1766 marksvec1767
labelvec1764))))) (wrap-subst1086 w1763)))))) (extend-ribcage!1098 (lambda
(ribcage1773 id1774 label1775) (begin (set-ribcage-symnames!1094 ribcage1773
(cons (let ((e1776 (syntax-object-expression1067 id1774))) (if (annotation?
e1776) (annotation-expression e1776) e1776)) (ribcage-symnames1091
ribcage1773))) (set-ribcage-marks!1095 ribcage1773 (cons (wrap-marks1085
(syntax-object-wrap1068 id1774)) (ribcage-marks1092 ribcage1773)))
(set-ribcage-labels!1096 ribcage1773 (cons label1775 (ribcage-labels1093
ribcage1773)))))) (anti-mark1097 (lambda (w1777) (make-wrap1084 (cons #f
(wrap-marks1085 w1777)) (cons (quote shift) (wrap-subst1086 w1777)))))
(set-ribcage-labels!1096 (lambda (x1778 update1779) (vector-set! x1778 3
update1779))) (set-ribcage-marks!1095 (lambda (x1780 update1781) (vector-set!
x1780 2 update1781))) (set-ribcage-symnames!1094 (lambda (x1782 update1783)
(vector-set! x1782 1 update1783))) (ribcage-labels1093 (lambda (x1784)
(vector-ref x1784 3))) (ribcage-marks1092 (lambda (x1785) (vector-ref x1785
2))) (ribcage-symnames1091 (lambda (x1786) (vector-ref x1786 1))) (ribcage?1090
(lambda (x1787) (and (vector? x1787) (= (vector-length x1787) 4) (eq?
(vector-ref x1787 0) (quote ribcage))))) (make-ribcage1089 (lambda
(symnames1788 marks1789 labels1790) (vector (quote ribcage) symnames1788
marks1789 labels1790))) (gen-labels1088 (lambda (ls1791) (if (null? ls1791)
(quote ()) (cons (gen-label1087) (gen-labels1088 (cdr ls1791))))))
(gen-label1087 (lambda () (string #\i))) (wrap-subst1086 cdr) (wrap-marks1085
car) (make-wrap1084 cons) (id-sym-name&marks1083 (lambda (x1792 w1793) (if
(syntax-object?1066 x1792) (values (let ((e1794 (syntax-object-expression1067
x1792))) (if (annotation? e1794) (annotation-expression e1794) e1794))
(join-marks1102 (wrap-marks1085 w1793) (wrap-marks1085 (syntax-object-wrap1068
x1792)))) (values (let ((e1795 x1792)) (if (annotation? e1795)
(annotation-expression e1795) e1795)) (wrap-marks1085 w1793))))) (id?1082
(lambda (x1796) (cond ((symbol? x1796) #t) ((syntax-object?1066 x1796) (symbol?
(let ((e1797 (syntax-object-expression1067 x1796))) (if (annotation? e1797)
(annotation-expression e1797) e1797)))) ((annotation? x1796) (symbol?
(annotation-expression x1796))) (else #f)))) (nonsymbol-id?1081 (lambda (x1798)
(and (syntax-object?1066 x1798) (symbol? (let ((e1799
(syntax-object-expression1067 x1798))) (if (annotation? e1799)
(annotation-expression e1799) e1799)))))) (global-extend1080 (lambda (type1800
sym1801 val1802) (put-global-definition-hook1057 sym1801 type1800 val1802)))
(lookup1079 (lambda (x1803 r1804 mod1805) (cond ((assq x1803 r1804) => cdr)
((symbol? x1803) (or (get-global-definition-hook1058 x1803 mod1805) (quote
(global)))) (else (quote (displaced-lexical)))))) (macros-only-env1078 (lambda
(r1806) (if (null? r1806) (quote ()) (let ((a1807 (car r1806))) (if (eq? (cadr
a1807) (quote macro)) (cons a1807 (macros-only-env1078 (cdr r1806)))
(macros-only-env1078 (cdr r1806))))))) (extend-var-env1077 (lambda (labels1808
vars1809 r1810) (if (null? labels1808) r1810 (extend-var-env1077 (cdr
labels1808) (cdr vars1809) (cons (cons (car labels1808) (cons (quote lexical)
(car vars1809))) r1810))))) (extend-env1076 (lambda (labels1811 bindings1812
r1813) (if (null? labels1811) r1813 (extend-env1076 (cdr labels1811) (cdr
bindings1812) (cons (cons (car labels1811) (car bindings1812)) r1813)))))
(binding-value1075 cdr) (binding-type1074 car) (source-annotation1073 (lambda
(x1814) (cond ((annotation? x1814) (annotation-source x1814))
((syntax-object?1066 x1814) (source-annotation1073
(syntax-object-expression1067 x1814))) (else #f))))
(set-syntax-object-module!1072 (lambda (x1815 update1816) (vector-set! x1815 3
update1816))) (set-syntax-object-wrap!1071 (lambda (x1817 update1818)
(vector-set! x1817 2 update1818))) (set-syntax-object-expression!1070 (lambda
(x1819 update1820) (vector-set! x1819 1 update1820))) (syntax-object-module1069
(lambda (x1821) (vector-ref x1821 3))) (syntax-object-wrap1068 (lambda (x1822)
(vector-ref x1822 2))) (syntax-object-expression1067 (lambda (x1823)
(vector-ref x1823 1))) (syntax-object?1066 (lambda (x1824) (and (vector? x1824)
(= (vector-length x1824) 4) (eq? (vector-ref x1824 0) (quote syntax-object)))))
(make-syntax-object1065 (lambda (expression1825 wrap1826 module1827) (vector
(quote syntax-object) expression1825 wrap1826 module1827))) (build-letrec1064
(lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829)
(build-annotated1059 src1828 body-exp1831) (build-annotated1059 src1828 (list
(quote letrec) (map list vars1829 val-exps1830) body-exp1831)))))
(build-named-let1063 (lambda (src1832 vars1833 val-exps1834 body-exp1835) (if
(null? vars1833) (build-annotated1059 src1832 body-exp1835)
(build-annotated1059 src1832 (list (quote let) (car vars1833) (map list (cdr
vars1833) val-exps1834) body-exp1835))))) (build-let1062 (lambda (src1836
vars1837 val-exps1838 body-exp1839) (if (null? vars1837) (build-annotated1059
src1836 body-exp1839) (build-annotated1059 src1836 (list (quote let) (map list
vars1837 val-exps1838) body-exp1839))))) (build-sequence1061 (lambda (src1840
exps1841) (if (null? (cdr exps1841)) (build-annotated1059 src1840 (car
exps1841)) (build-annotated1059 src1840 (cons (quote begin) exps1841)))))
(build-data1060 (lambda (src1842 exp1843) (if (and (self-evaluating? exp1843)
(not (vector? exp1843))) (build-annotated1059 src1842 exp1843)
(build-annotated1059 src1842 (list (quote quote) exp1843)))))
(build-annotated1059 (lambda (src1844 exp1845) (if (and src1844 (not
(annotation? exp1845))) (make-annotation exp1845 src1844 #t) exp1845)))
(get-global-definition-hook1058 (lambda (symbol1846 module1847) (begin (if (and
(not module1847) (current-module)) (warn "module system is booted, we should
have a module" symbol1846)) (let ((v1848 (module-variable (if module1847
(resolve-module (cdr module1847)) (current-module)) symbol1846))) (and v1848
(variable-bound? v1848) (let ((val1849 (variable-ref v1848))) (and (macro?
val1849) (syncase-macro-type val1849) (cons (syncase-macro-type val1849)
(syncase-macro-binding val1849))))))))) (put-global-definition-hook1057 (lambda
(symbol1850 type1851 val1852) (let ((existing1853 (let ((v1854 (module-variable
(current-module) symbol1850))) (and v1854 (variable-bound? v1854) (let
((val1855 (variable-ref v1854))) (and (macro? val1855) (not (syncase-macro-type
val1855)) val1855)))))) (module-define! (current-module) symbol1850 (if
existing1853 (make-extended-syncase-macro existing1853 type1851 val1852)
(make-syncase-macro type1851 val1852)))))) (error-hook1056 (lambda (who1856
why1857 what1858) (error who1856 "~a ~s" why1857 what1858)))
(local-eval-hook1055 (lambda (x1859 mod1860) (primitive-eval (list noexpand1049
x1859)))) (top-level-eval-hook1054 (lambda (x1861 mod1862) (primitive-eval
(list noexpand1049 x1861)))) (fx<1053 <) (fx=1052 =) (fx-1051 -) (fx+1050 +)
(noexpand1049 "noexpand")) (begin (global-extend1080 (quote local-syntax)
(quote letrec-syntax) #t) (global-extend1080 (quote local-syntax) (quote
let-syntax) #f) (global-extend1080 (quote core) (quote fluid-let-syntax)
(lambda (e1863 r1864 w1865 s1866 mod1867) ((lambda (tmp1868) ((lambda (tmp1869)
(if (if tmp1869 (apply (lambda (_1870 var1871 val1872 e11873 e21874)
(valid-bound-ids?1107 var1871)) tmp1869) #f) (apply (lambda (_1876 var1877
val1878 e11879 e21880) (let ((names1881 (map (lambda (x1882) (id-var-name1104
x1882 w1865)) var1877))) (begin (for-each (lambda (id1884 n1885) (let ((t1886
(binding-type1074 (lookup1079 n1885 r1864 mod1867)))) (if (memv t1886 (quote
(displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier
out of context" e1863 (source-wrap1111 id1884 w1865 s1866 mod1867))))) var1877
names1881) (chi-body1122 (cons e11879 e21880) (source-wrap1111 e1863 w1865
s1866 mod1867) (extend-env1076 names1881 (let ((trans-r1889
(macros-only-env1078 r1864))) (map (lambda (x1890) (cons (quote macro)
(eval-local-transformer1125 (chi1118 x1890 trans-r1889 w1865 mod1867)
mod1867))) val1878)) r1864) w1865 mod1867)))) tmp1869) ((lambda (_1892)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1111 e1863
w1865 s1866 mod1867))) tmp1868))) ($sc-dispatch tmp1868 (quote (any #(each (any
any)) any . each-any))))) e1863))) (global-extend1080 (quote core) (quote
quote) (lambda (e1893 r1894 w1895 s1896 mod1897) ((lambda (tmp1898) ((lambda
(tmp1899) (if tmp1899 (apply (lambda (_1900 e1901) (build-data1060 s1896
(strip1129 e1901 w1895))) tmp1899) ((lambda (_1902) (syntax-violation (quote
quote) "bad syntax" (source-wrap1111 e1893 w1895 s1896 mod1897))) tmp1898)))
($sc-dispatch tmp1898 (quote (any any))))) e1893))) (global-extend1080 (quote
core) (quote syntax) (letrec ((regen1910 (lambda (x1911) (let ((t1912 (car
x1911))) (if (memv t1912 (quote (ref))) (build-annotated1059 #f (cadr x1911))
(if (memv t1912 (quote (primitive))) (build-annotated1059 #f (cadr x1911)) (if
(memv t1912 (quote (quote))) (build-data1060 #f (cadr x1911)) (if (memv t1912
(quote (lambda))) (build-annotated1059 #f (list (quote lambda) (cadr x1911)
(regen1910 (caddr x1911)))) (if (memv t1912 (quote (map))) (let ((ls1913 (map
regen1910 (cdr x1911)))) (build-annotated1059 #f (cons (if (fx=1052 (length
ls1913) 2) (build-annotated1059 #f (quote map)) (build-annotated1059 #f (quote
map))) ls1913))) (build-annotated1059 #f (cons (build-annotated1059 #f (car
x1911)) (map regen1910 (cdr x1911)))))))))))) (gen-vector1909 (lambda (x1914)
(cond ((eq? (car x1914) (quote list)) (cons (quote vector) (cdr x1914))) ((eq?
(car x1914) (quote quote)) (list (quote quote) (list->vector (cadr x1914))))
(else (list (quote list->vector) x1914))))) (gen-append1908 (lambda (x1915
y1916) (if (equal? y1916 (quote (quote ()))) x1915 (list (quote append) x1915
y1916)))) (gen-cons1907 (lambda (x1917 y1918) (let ((t1919 (car y1918))) (if
(memv t1919 (quote (quote))) (if (eq? (car x1917) (quote quote)) (list (quote
quote) (cons (cadr x1917) (cadr y1918))) (if (eq? (cadr y1918) (quote ()))
(list (quote list) x1917) (list (quote cons) x1917 y1918))) (if (memv t1919
(quote (list))) (cons (quote list) (cons x1917 (cdr y1918))) (list (quote cons)
x1917 y1918)))))) (gen-map1906 (lambda (e1920 map-env1921) (let ((formals1922
(map cdr map-env1921)) (actuals1923 (map (lambda (x1924) (list (quote ref) (car
x1924))) map-env1921))) (cond ((eq? (car e1920) (quote ref)) (car actuals1923))
((andmap (lambda (x1925) (and (eq? (car x1925) (quote ref)) (memq (cadr x1925)
formals1922))) (cdr e1920)) (cons (quote map) (cons (list (quote primitive)
(car e1920)) (map (let ((r1926 (map cons formals1922 actuals1923))) (lambda
(x1927) (cdr (assq (cadr x1927) r1926)))) (cdr e1920))))) (else (cons (quote
map) (cons (list (quote lambda) formals1922 e1920) actuals1923)))))))
(gen-mappend1905 (lambda (e1928 map-env1929) (list (quote apply) (quote
(primitive append)) (gen-map1906 e1928 map-env1929)))) (gen-ref1904 (lambda
(src1930 var1931 level1932 maps1933) (if (fx=1052 level1932 0) (values var1931
maps1933) (if (null? maps1933) (syntax-violation (quote syntax) "missing
ellipsis" src1930) (call-with-values (lambda () (gen-ref1904 src1930 var1931
(fx-1051 level1932 1) (cdr maps1933))) (lambda (outer-var1934 outer-maps1935)
(let ((b1936 (assq outer-var1934 (car maps1933)))) (if b1936 (values (cdr
b1936) maps1933) (let ((inner-var1937 (gen-var1130 (quote tmp)))) (values
inner-var1937 (cons (cons (cons outer-var1934 inner-var1937) (car maps1933))
outer-maps1935))))))))))) (gen-syntax1903 (lambda (src1938 e1939 r1940 maps1941
ellipsis?1942 mod1943) (if (id?1082 e1939) (let ((label1944 (id-var-name1104
e1939 (quote (()))))) (let ((b1945 (lookup1079 label1944 r1940 mod1943))) (if
(eq? (binding-type1074 b1945) (quote syntax)) (call-with-values (lambda () (let
((var.lev1946 (binding-value1075 b1945))) (gen-ref1904 src1938 (car
var.lev1946) (cdr var.lev1946) maps1941))) (lambda (var1947 maps1948) (values
(list (quote ref) var1947) maps1948))) (if (ellipsis?1942 e1939)
(syntax-violation (quote syntax) "misplaced ellipsis" src1938) (values (list
(quote quote) e1939) maps1941))))) ((lambda (tmp1949) ((lambda (tmp1950) (if
(if tmp1950 (apply (lambda (dots1951 e1952) (ellipsis?1942 dots1951)) tmp1950)
#f) (apply (lambda (dots1953 e1954) (gen-syntax1903 src1938 e1954 r1940
maps1941 (lambda (x1955) #f) mod1943)) tmp1950) ((lambda (tmp1956) (if (if
tmp1956 (apply (lambda (x1957 dots1958 y1959) (ellipsis?1942 dots1958))
tmp1956) #f) (apply (lambda (x1960 dots1961 y1962) (let f1963 ((y1964 y1962)
(k1965 (lambda (maps1966) (call-with-values (lambda () (gen-syntax1903 src1938
x1960 r1940 (cons (quote ()) maps1966) ellipsis?1942 mod1943)) (lambda (x1967
maps1968) (if (null? (car maps1968)) (syntax-violation (quote syntax) "extra
ellipsis" src1938) (values (gen-map1906 x1967 (car maps1968)) (cdr
maps1968)))))))) ((lambda (tmp1969) ((lambda (tmp1970) (if (if tmp1970 (apply
(lambda (dots1971 y1972) (ellipsis?1942 dots1971)) tmp1970) #f) (apply (lambda
(dots1973 y1974) (f1963 y1974 (lambda (maps1975) (call-with-values (lambda ()
(k1965 (cons (quote ()) maps1975))) (lambda (x1976 maps1977) (if (null? (car
maps1977)) (syntax-violation (quote syntax) "extra ellipsis" src1938) (values
(gen-mappend1905 x1976 (car maps1977)) (cdr maps1977)))))))) tmp1970) ((lambda
(_1978) (call-with-values (lambda () (gen-syntax1903 src1938 y1964 r1940
maps1941 ellipsis?1942 mod1943)) (lambda (y1979 maps1980) (call-with-values
(lambda () (k1965 maps1980)) (lambda (x1981 maps1982) (values (gen-append1908
x1981 y1979) maps1982)))))) tmp1969))) ($sc-dispatch tmp1969 (quote (any .
any))))) y1964))) tmp1956) ((lambda (tmp1983) (if tmp1983 (apply (lambda (x1984
y1985) (call-with-values (lambda () (gen-syntax1903 src1938 x1984 r1940
maps1941 ellipsis?1942 mod1943)) (lambda (x1986 maps1987) (call-with-values
(lambda () (gen-syntax1903 src1938 y1985 r1940 maps1987 ellipsis?1942 mod1943))
(lambda (y1988 maps1989) (values (gen-cons1907 x1986 y1988) maps1989))))))
tmp1983) ((lambda (tmp1990) (if tmp1990 (apply (lambda (e11991 e21992)
(call-with-values (lambda () (gen-syntax1903 src1938 (cons e11991 e21992) r1940
maps1941 ellipsis?1942 mod1943)) (lambda (e1994 maps1995) (values
(gen-vector1909 e1994) maps1995)))) tmp1990) ((lambda (_1996) (values (list
(quote quote) e1939) maps1941)) tmp1949))) ($sc-dispatch tmp1949 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp1949 (quote (any . any))))))
($sc-dispatch tmp1949 (quote (any any . any)))))) ($sc-dispatch tmp1949 (quote
(any any))))) e1939))))) (lambda (e1997 r1998 w1999 s2000 mod2001) (let ((e2002
(source-wrap1111 e1997 w1999 s2000 mod2001))) ((lambda (tmp2003) ((lambda
(tmp2004) (if tmp2004 (apply (lambda (_2005 x2006) (call-with-values (lambda ()
(gen-syntax1903 e2002 x2006 r1998 (quote ()) ellipsis?1127 mod2001)) (lambda
(e2007 maps2008) (regen1910 e2007)))) tmp2004) ((lambda (_2009)
(syntax-violation (quote syntax) "bad `syntax' form" e2002)) tmp2003)))
($sc-dispatch tmp2003 (quote (any any))))) e2002))))) (global-extend1080 (quote
core) (quote lambda) (lambda (e2010 r2011 w2012 s2013 mod2014) ((lambda
(tmp2015) ((lambda (tmp2016) (if tmp2016 (apply (lambda (_2017 c2018)
(chi-lambda-clause1123 (source-wrap1111 e2010 w2012 s2013 mod2014) #f c2018
r2011 w2012 mod2014 (lambda (vars2019 docstring2020 body2021)
(build-annotated1059 s2013 (cons (quote lambda) (cons vars2019 (append (if
docstring2020 (list docstring2020) (quote ())) (list body2021)))))))) tmp2016)
(syntax-violation #f "source expression failed to match any pattern" tmp2015)))
($sc-dispatch tmp2015 (quote (any . any))))) e2010))) (global-extend1080 (quote
core) (quote let) (letrec ((chi-let2022 (lambda (e2023 r2024 w2025 s2026
mod2027 constructor2028 ids2029 vals2030 exps2031) (if (not
(valid-bound-ids?1107 ids2029)) (syntax-violation (quote let) "duplicate bound
variable" e2023) (let ((labels2032 (gen-labels1088 ids2029)) (new-vars2033 (map
gen-var1130 ids2029))) (let ((nw2034 (make-binding-wrap1099 ids2029 labels2032
w2025)) (nr2035 (extend-var-env1077 labels2032 new-vars2033 r2024)))
(constructor2028 s2026 new-vars2033 (map (lambda (x2036) (chi1118 x2036 r2024
w2025 mod2027)) vals2030) (chi-body1122 exps2031 (source-wrap1111 e2023 nw2034
s2026 mod2027) nr2035 nw2034 mod2027)))))))) (lambda (e2037 r2038 w2039 s2040
mod2041) ((lambda (tmp2042) ((lambda (tmp2043) (if tmp2043 (apply (lambda
(_2044 id2045 val2046 e12047 e22048) (chi-let2022 e2037 r2038 w2039 s2040
mod2041 build-let1062 id2045 val2046 (cons e12047 e22048))) tmp2043) ((lambda
(tmp2052) (if (if tmp2052 (apply (lambda (_2053 f2054 id2055 val2056 e12057
e22058) (id?1082 f2054)) tmp2052) #f) (apply (lambda (_2059 f2060 id2061
val2062 e12063 e22064) (chi-let2022 e2037 r2038 w2039 s2040 mod2041
build-named-let1063 (cons f2060 id2061) val2062 (cons e12063 e22064))) tmp2052)
((lambda (_2068) (syntax-violation (quote let) "bad let" (source-wrap1111 e2037
w2039 s2040 mod2041))) tmp2042))) ($sc-dispatch tmp2042 (quote (any any #(each
(any any)) any . each-any)))))) ($sc-dispatch tmp2042 (quote (any #(each (any
any)) any . each-any))))) e2037)))) (global-extend1080 (quote core) (quote
letrec) (lambda (e2069 r2070 w2071 s2072 mod2073) ((lambda (tmp2074) ((lambda
(tmp2075) (if tmp2075 (apply (lambda (_2076 id2077 val2078 e12079 e22080) (let
((ids2081 id2077)) (if (not (valid-bound-ids?1107 ids2081)) (syntax-violation
(quote letrec) "duplicate bound variable" e2069) (let ((labels2083
(gen-labels1088 ids2081)) (new-vars2084 (map gen-var1130 ids2081))) (let
((w2085 (make-binding-wrap1099 ids2081 labels2083 w2071)) (r2086
(extend-var-env1077 labels2083 new-vars2084 r2070))) (build-letrec1064 s2072
new-vars2084 (map (lambda (x2087) (chi1118 x2087 r2086 w2085 mod2073)) val2078)
(chi-body1122 (cons e12079 e22080) (source-wrap1111 e2069 w2085 s2072 mod2073)
r2086 w2085 mod2073))))))) tmp2075) ((lambda (_2090) (syntax-violation (quote
letrec) "bad letrec" (source-wrap1111 e2069 w2071 s2072 mod2073))) tmp2074)))
($sc-dispatch tmp2074 (quote (any #(each (any any)) any . each-any)))))
e2069))) (global-extend1080 (quote core) (quote set!) (lambda (e2091 r2092
w2093 s2094 mod2095) ((lambda (tmp2096) ((lambda (tmp2097) (if (if tmp2097
(apply (lambda (_2098 id2099 val2100) (id?1082 id2099)) tmp2097) #f) (apply
(lambda (_2101 id2102 val2103) (let ((val2104 (chi1118 val2103 r2092 w2093
mod2095)) (n2105 (id-var-name1104 id2102 w2093))) (let ((b2106 (lookup1079
n2105 r2092 mod2095))) (let ((t2107 (binding-type1074 b2106))) (if (memv t2107
(quote (lexical))) (build-annotated1059 s2094 (list (quote set!)
(binding-value1075 b2106) val2104)) (if (memv t2107 (quote (global)))
(build-annotated1059 s2094 (list (quote set!) (if mod2095 (make-module-ref (cdr
mod2095) n2105 (car mod2095)) (make-module-ref mod2095 n2105 (quote bare)))
val2104)) (if (memv t2107 (quote (displaced-lexical))) (syntax-violation (quote
set!) "identifier out of context" (wrap1110 id2102 w2093 mod2095))
(syntax-violation (quote set!) "bad set!" (source-wrap1111 e2091 w2093 s2094
mod2095))))))))) tmp2097) ((lambda (tmp2108) (if tmp2108 (apply (lambda (_2109
head2110 tail2111 val2112) (call-with-values (lambda () (syntax-type1116
head2110 r2092 (quote (())) #f #f mod2095)) (lambda (type2113 value2114 ee2115
ww2116 ss2117 modmod2118) (let ((t2119 type2113)) (if (memv t2119 (quote
(module-ref))) (let ((val2120 (chi1118 val2112 r2092 w2093 mod2095)))
(call-with-values (lambda () (value2114 (cons head2110 tail2111))) (lambda
(id2122 mod2123) (build-annotated1059 s2094 (list (quote set!) (if mod2123
(make-module-ref (cdr mod2123) id2122 (car mod2123)) (make-module-ref mod2123
id2122 (quote bare))) val2120))))) (build-annotated1059 s2094 (cons (chi1118
(list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t)
#(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type
value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((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-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object 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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2110) r2092
w2093 mod2095) (map (lambda (e2124) (chi1118 e2124 r2092 w2093 mod2095))
(append tail2111 (list val2112)))))))))) tmp2108) ((lambda (_2126)
(syntax-violation (quote set!) "bad set!" (source-wrap1111 e2091 w2093 s2094
mod2095))) tmp2096))) ($sc-dispatch tmp2096 (quote (any (any . each-any)
any)))))) ($sc-dispatch tmp2096 (quote (any any any))))) e2091)))
(global-extend1080 (quote module-ref) (quote @) (lambda (e2127) ((lambda
(tmp2128) ((lambda (tmp2129) (if (if tmp2129 (apply (lambda (_2130 mod2131
id2132) (and (andmap id?1082 mod2131) (id?1082 id2132))) tmp2129) #f) (apply
(lambda (_2134 mod2135 id2136) (values (syntax->datum id2136) (syntax->datum
(cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2135))))
tmp2129) (syntax-violation #f "source expression failed to match any pattern"
tmp2128))) ($sc-dispatch tmp2128 (quote (any each-any any))))) e2127)))
(global-extend1080 (quote module-ref) (quote @@) (lambda (e2138) ((lambda
(tmp2139) ((lambda (tmp2140) (if (if tmp2140 (apply (lambda (_2141 mod2142
id2143) (and (andmap id?1082 mod2142) (id?1082 id2143))) tmp2140) #f) (apply
(lambda (_2145 mod2146 id2147) (values (syntax->datum id2147) (syntax->datum
(cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2146))))
tmp2140) (syntax-violation #f "source expression failed to match any pattern"
tmp2139))) ($sc-dispatch tmp2139 (quote (any each-any any))))) e2138)))
(global-extend1080 (quote begin) (quote begin) (quote ())) (global-extend1080
(quote define) (quote define) (quote ())) (global-extend1080 (quote
define-syntax) (quote define-syntax) (quote ())) (global-extend1080 (quote
eval-when) (quote eval-when) (quote ())) (global-extend1080 (quote core) (quote
syntax-case) (letrec ((gen-syntax-case2152 (lambda (x2153 keys2154 clauses2155
r2156 mod2157) (if (null? clauses2155) (build-annotated1059 #f (list
(build-annotated1059 #f (quote syntax-violation)) #f "source expression failed
to match any pattern" x2153)) ((lambda (tmp2158) ((lambda (tmp2159) (if tmp2159
(apply (lambda (pat2160 exp2161) (if (and (id?1082 pat2160) (andmap (lambda
(x2162) (not (free-id=?1105 pat2160 x2162))) (cons (quote #(syntax-object ...
((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook error-hook
local-eval-hook top-level-eval-hook 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) (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" "i"))
#(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2154))) (let
((labels2163 (list (gen-label1087))) (var2164 (gen-var1130 pat2160)))
(build-annotated1059 #f (list (build-annotated1059 #f (list (quote lambda)
(list var2164) (chi1118 exp2161 (extend-env1076 labels2163 (list (cons (quote
syntax) (cons var2164 0))) r2156) (make-binding-wrap1099 (list pat2160)
labels2163 (quote (()))) mod2157))) x2153))) (gen-clause2151 x2153 keys2154
(cdr clauses2155) r2156 pat2160 #t exp2161 mod2157))) tmp2159) ((lambda
(tmp2165) (if tmp2165 (apply (lambda (pat2166 fender2167 exp2168)
(gen-clause2151 x2153 keys2154 (cdr clauses2155) r2156 pat2166 fender2167
exp2168 mod2157)) tmp2165) ((lambda (_2169) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses2155))) tmp2158))) ($sc-dispatch
tmp2158 (quote (any any any)))))) ($sc-dispatch tmp2158 (quote (any any)))))
(car clauses2155))))) (gen-clause2151 (lambda (x2170 keys2171 clauses2172 r2173
pat2174 fender2175 exp2176 mod2177) (call-with-values (lambda ()
(convert-pattern2149 pat2174 keys2171)) (lambda (p2178 pvars2179) (cond ((not
(distinct-bound-ids?1108 (map car pvars2179))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat2174)) ((not (andmap (lambda
(x2180) (not (ellipsis?1127 (car x2180)))) pvars2179)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat2174)) (else (let ((y2181 (gen-var1130
(quote tmp)))) (build-annotated1059 #f (list (build-annotated1059 #f (list
(quote lambda) (list y2181) (let ((y2182 (build-annotated1059 #f y2181)))
(build-annotated1059 #f (list (quote if) ((lambda (tmp2183) ((lambda (tmp2184)
(if tmp2184 (apply (lambda () y2182) tmp2184) ((lambda (_2185)
(build-annotated1059 #f (list (quote if) y2182 (build-dispatch-call2150
pvars2179 fender2175 y2182 r2173 mod2177) (build-data1060 #f #f)))) tmp2183)))
($sc-dispatch tmp2183 (quote #(atom #t))))) fender2175)
(build-dispatch-call2150 pvars2179 exp2176 y2182 r2173 mod2177)
(gen-syntax-case2152 x2170 keys2171 clauses2172 r2173 mod2177)))))) (if (eq?
p2178 (quote any)) (build-annotated1059 #f (list (build-annotated1059 #f (quote
list)) x2170)) (build-annotated1059 #f (list (build-annotated1059 #f (quote
$sc-dispatch)) x2170 (build-data1060 #f p2178)))))))))))))
(build-dispatch-call2150 (lambda (pvars2186 exp2187 y2188 r2189 mod2190) (let
((ids2191 (map car pvars2186)) (levels2192 (map cdr pvars2186))) (let
((labels2193 (gen-labels1088 ids2191)) (new-vars2194 (map gen-var1130
ids2191))) (build-annotated1059 #f (list (build-annotated1059 #f (quote apply))
(build-annotated1059 #f (list (quote lambda) new-vars2194 (chi1118 exp2187
(extend-env1076 labels2193 (map (lambda (var2195 level2196) (cons (quote
syntax) (cons var2195 level2196))) new-vars2194 (map cdr pvars2186)) r2189)
(make-binding-wrap1099 ids2191 labels2193 (quote (()))) mod2190))) y2188))))))
(convert-pattern2149 (lambda (pattern2197 keys2198) (let cvt2199 ((p2200
pattern2197) (n2201 0) (ids2202 (quote ()))) (if (id?1082 p2200) (if
(bound-id-member?1109 p2200 keys2198) (values (vector (quote free-id) p2200)
ids2202) (values (quote any) (cons (cons p2200 n2201) ids2202))) ((lambda
(tmp2203) ((lambda (tmp2204) (if (if tmp2204 (apply (lambda (x2205 dots2206)
(ellipsis?1127 dots2206)) tmp2204) #f) (apply (lambda (x2207 dots2208)
(call-with-values (lambda () (cvt2199 x2207 (fx+1050 n2201 1) ids2202)) (lambda
(p2209 ids2210) (values (if (eq? p2209 (quote any)) (quote each-any) (vector
(quote each) p2209)) ids2210)))) tmp2204) ((lambda (tmp2211) (if tmp2211 (apply
(lambda (x2212 y2213) (call-with-values (lambda () (cvt2199 y2213 n2201
ids2202)) (lambda (y2214 ids2215) (call-with-values (lambda () (cvt2199 x2212
n2201 ids2215)) (lambda (x2216 ids2217) (values (cons x2216 y2214)
ids2217)))))) tmp2211) ((lambda (tmp2218) (if tmp2218 (apply (lambda () (values
(quote ()) ids2202)) tmp2218) ((lambda (tmp2219) (if tmp2219 (apply (lambda
(x2220) (call-with-values (lambda () (cvt2199 x2220 n2201 ids2202)) (lambda
(p2222 ids2223) (values (vector (quote vector) p2222) ids2223)))) tmp2219)
((lambda (x2224) (values (vector (quote atom) (strip1129 p2200 (quote (()))))
ids2202)) tmp2203))) ($sc-dispatch tmp2203 (quote #(vector each-any))))))
($sc-dispatch tmp2203 (quote ()))))) ($sc-dispatch tmp2203 (quote (any .
any)))))) ($sc-dispatch tmp2203 (quote (any any))))) p2200)))))) (lambda (e2225
r2226 w2227 s2228 mod2229) (let ((e2230 (source-wrap1111 e2225 w2227 s2228
mod2229))) ((lambda (tmp2231) ((lambda (tmp2232) (if tmp2232 (apply (lambda
(_2233 val2234 key2235 m2236) (if (andmap (lambda (x2237) (and (id?1082 x2237)
(not (ellipsis?1127 x2237)))) key2235) (let ((x2239 (gen-var1130 (quote tmp))))
(build-annotated1059 s2228 (list (build-annotated1059 #f (list (quote lambda)
(list x2239) (gen-syntax-case2152 (build-annotated1059 #f x2239) key2235 m2236
r2226 mod2229))) (chi1118 val2234 r2226 (quote (())) mod2229))))
(syntax-violation (quote syntax-case) "invalid literals list" e2230))) tmp2232)
(syntax-violation #f "source expression failed to match any pattern" tmp2231)))
($sc-dispatch tmp2231 (quote (any any each-any . each-any))))) e2230))))) (set!
sc-expand (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2244)
(if (and (pair? x2244) (equal? (car x2244) noexpand1049)) (cadr x2244)
(chi-top1117 x2244 (quote ()) (quote ((top))) m2242 esew2243 (cons (quote
hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2245
(quote e)) (esew2246 (quote (eval)))) (lambda (x2248 . rest2247) (if (and
(pair? x2248) (equal? (car x2248) noexpand1049)) (cadr x2248) (chi-top1117
x2248 (quote ()) (quote ((top))) (if (null? rest2247) m2245 (car rest2247)) (if
(or (null? rest2247) (null? (cdr rest2247))) esew2246 (cadr rest2247)) (cons
(quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda
(x2249) (nonsymbol-id?1081 x2249))) (set! datum->syntax (lambda (id2250
datum2251) (make-syntax-object1065 datum2251 (syntax-object-wrap1068 id2250)
#f))) (set! syntax->datum (lambda (x2252) (strip1129 x2252 (quote (())))))
(set! generate-temporaries (lambda (ls2253) (begin (let ((x2254 ls2253)) (if
(not (list? x2254)) (error-hook1056 (quote generate-temporaries) "invalid
argument" x2254))) (map (lambda (x2255) (wrap1110 (gensym) (quote ((top))) #f))
ls2253)))) (set! free-identifier=? (lambda (x2256 y2257) (begin (let ((x2258
x2256)) (if (not (nonsymbol-id?1081 x2258)) (error-hook1056 (quote
free-identifier=?) "invalid argument" x2258))) (let ((x2259 y2257)) (if (not
(nonsymbol-id?1081 x2259)) (error-hook1056 (quote free-identifier=?) "invalid
argument" x2259))) (free-id=?1105 x2256 y2257)))) (set! bound-identifier=?
(lambda (x2260 y2261) (begin (let ((x2262 x2260)) (if (not (nonsymbol-id?1081
x2262)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2262)))
(let ((x2263 y2261)) (if (not (nonsymbol-id?1081 x2263)) (error-hook1056 (quote
bound-identifier=?) "invalid argument" x2263))) (bound-id=?1106 x2260 y2261))))
(set! syntax-violation (lambda (who2267 message2266 form2265 . subform2264)
(begin (let ((x2268 who2267)) (if (not ((lambda (x2269) (or (not x2269)
(string? x2269) (symbol? x2269))) x2268)) (error-hook1056 (quote
syntax-violation) "invalid argument" x2268))) (let ((x2270 message2266)) (if
(not (string? x2270)) (error-hook1056 (quote syntax-violation) "invalid
argument" x2270))) (scm-error (quote syntax-error) (quote sc-expand)
(string-append (if who2267 "~a: " "") "~a " (if (null? subform2264) "in ~a" "in
subform `~s' of `~s'")) (let ((tail2271 (cons message2266 (map (lambda (x2272)
(strip1129 x2272 (quote (())))) (append subform2264 (list form2265)))))) (if
who2267 (cons who2267 tail2271) tail2271)) #f)))) (set!
install-global-transformer (lambda (sym2273 v2274) (begin (let ((x2275
sym2273)) (if (not (symbol? x2275)) (error-hook1056 (quote define-syntax)
"invalid argument" x2275))) (let ((x2276 v2274)) (if (not (procedure? x2276))
(error-hook1056 (quote define-syntax) "invalid argument" x2276)))
(global-extend1080 (quote macro) sym2273 v2274)))) (letrec ((match2281 (lambda
(e2282 p2283 w2284 r2285 mod2286) (cond ((not r2285) #f) ((eq? p2283 (quote
any)) (cons (wrap1110 e2282 w2284 mod2286) r2285)) ((syntax-object?1066 e2282)
(match*2280 (let ((e2287 (syntax-object-expression1067 e2282))) (if
(annotation? e2287) (annotation-expression e2287) e2287)) p2283 (join-wraps1101
w2284 (syntax-object-wrap1068 e2282)) r2285 (syntax-object-module1069 e2282)))
(else (match*2280 (let ((e2288 e2282)) (if (annotation? e2288)
(annotation-expression e2288) e2288)) p2283 w2284 r2285 mod2286)))))
(match*2280 (lambda (e2289 p2290 w2291 r2292 mod2293) (cond ((null? p2290) (and
(null? e2289) r2292)) ((pair? p2290) (and (pair? e2289) (match2281 (car e2289)
(car p2290) w2291 (match2281 (cdr e2289) (cdr p2290) w2291 r2292 mod2293)
mod2293))) ((eq? p2290 (quote each-any)) (let ((l2294 (match-each-any2278 e2289
w2291 mod2293))) (and l2294 (cons l2294 r2292)))) (else (let ((t2295
(vector-ref p2290 0))) (if (memv t2295 (quote (each))) (if (null? e2289)
(match-empty2279 (vector-ref p2290 1) r2292) (let ((l2296 (match-each2277 e2289
(vector-ref p2290 1) w2291 mod2293))) (and l2296 (let collect2297 ((l2298
l2296)) (if (null? (car l2298)) r2292 (cons (map car l2298) (collect2297 (map
cdr l2298)))))))) (if (memv t2295 (quote (free-id))) (and (id?1082 e2289)
(free-id=?1105 (wrap1110 e2289 w2291 mod2293) (vector-ref p2290 1)) r2292) (if
(memv t2295 (quote (atom))) (and (equal? (vector-ref p2290 1) (strip1129 e2289
w2291)) r2292) (if (memv t2295 (quote (vector))) (and (vector? e2289)
(match2281 (vector->list e2289) (vector-ref p2290 1) w2291 r2292
mod2293))))))))))) (match-empty2279 (lambda (p2299 r2300) (cond ((null? p2299)
r2300) ((eq? p2299 (quote any)) (cons (quote ()) r2300)) ((pair? p2299)
(match-empty2279 (car p2299) (match-empty2279 (cdr p2299) r2300))) ((eq? p2299
(quote each-any)) (cons (quote ()) r2300)) (else (let ((t2301 (vector-ref p2299
0))) (if (memv t2301 (quote (each))) (match-empty2279 (vector-ref p2299 1)
r2300) (if (memv t2301 (quote (free-id atom))) r2300 (if (memv t2301 (quote
(vector))) (match-empty2279 (vector-ref p2299 1) r2300)))))))))
(match-each-any2278 (lambda (e2302 w2303 mod2304) (cond ((annotation? e2302)
(match-each-any2278 (annotation-expression e2302) w2303 mod2304)) ((pair?
e2302) (let ((l2305 (match-each-any2278 (cdr e2302) w2303 mod2304))) (and l2305
(cons (wrap1110 (car e2302) w2303 mod2304) l2305)))) ((null? e2302) (quote ()))
((syntax-object?1066 e2302) (match-each-any2278 (syntax-object-expression1067
e2302) (join-wraps1101 w2303 (syntax-object-wrap1068 e2302)) mod2304)) (else
#f)))) (match-each2277 (lambda (e2306 p2307 w2308 mod2309) (cond ((annotation?
e2306) (match-each2277 (annotation-expression e2306) p2307 w2308 mod2309))
((pair? e2306) (let ((first2310 (match2281 (car e2306) p2307 w2308 (quote ())
mod2309))) (and first2310 (let ((rest2311 (match-each2277 (cdr e2306) p2307
w2308 mod2309))) (and rest2311 (cons first2310 rest2311)))))) ((null? e2306)
(quote ())) ((syntax-object?1066 e2306) (match-each2277
(syntax-object-expression1067 e2306) p2307 (join-wraps1101 w2308
(syntax-object-wrap1068 e2306)) (syntax-object-module1069 e2306))) (else
#f))))) (set! $sc-dispatch (lambda (e2312 p2313) (cond ((eq? p2313 (quote any))
(list e2312)) ((syntax-object?1066 e2312) (match*2280 (let ((e2314
(syntax-object-expression1067 e2312))) (if (annotation? e2314)
(annotation-expression e2314) e2314)) p2313 (syntax-object-wrap1068 e2312)
(quote ()) (syntax-object-module1069 e2312))) (else (match*2280 (let ((e2315
e2312)) (if (annotation? e2315) (annotation-expression e2315) e2315)) p2313
(quote (())) (quote ()) #f))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x2316) ((lambda
(tmp2317) ((lambda (tmp2318) (if tmp2318 (apply (lambda (_2319 e12320 e22321)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e12320 e22321))) tmp2318) ((lambda (tmp2323) (if
tmp2323 (apply (lambda (_2324 out2325 in2326 e12327 e22328) (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"))) (hygiene guile))) in2326 (quote ()) (list out2325 (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"))) (hygiene guile))) (cons e12327 e22328))))) tmp2323) ((lambda
(tmp2330) (if tmp2330 (apply (lambda (_2331 out2332 in2333 e12334 e22335) (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"))) (hygiene guile))) (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"))) (hygiene
guile))) in2333) (quote ()) (list out2332 (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"))) (hygiene
guile))) (cons e12334 e22335))))) tmp2330) (syntax-violation #f "source
expression failed to match any pattern" tmp2317))) ($sc-dispatch tmp2317 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2317 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp2317 (quote (any () any .
each-any))))) x2316))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2339)
((lambda (tmp2340) ((lambda (tmp2341) (if tmp2341 (apply (lambda (_2342 k2343
keyword2344 pattern2345 template2346) (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"))) (hygiene guile))) (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"))) (hygiene guile))))
(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"))) (hygiene guile))) (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"))) (hygiene guile))) (cons k2343 (map (lambda (tmp2349
tmp2348) (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"))) (hygiene guile)))
tmp2348) (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"))) (hygiene guile)))
tmp2349))) template2346 pattern2345)))))) tmp2341) (syntax-violation #f "source
expression failed to match any pattern" tmp2340))) ($sc-dispatch tmp2340 (quote
(any each-any . #(each ((any . any) any))))))) x2339))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x2350) ((lambda (tmp2351) ((lambda (tmp2352) (if
(if tmp2352 (apply (lambda (let*2353 x2354 v2355 e12356 e22357) (andmap
identifier? x2354)) tmp2352) #f) (apply (lambda (let*2359 x2360 v2361 e12362
e22363) (let f2364 ((bindings2365 (map list x2360 v2361))) (if (null?
bindings2365) (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"))) (hygiene guile))) (cons (quote ()) (cons
e12362 e22363))) ((lambda (tmp2369) ((lambda (tmp2370) (if tmp2370 (apply
(lambda (body2371 binding2372) (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"))) (hygiene guile))) (list binding2372)
body2371)) tmp2370) (syntax-violation #f "source expression failed to match any
pattern" tmp2369))) ($sc-dispatch tmp2369 (quote (any any))))) (list (f2364
(cdr bindings2365)) (car bindings2365)))))) tmp2352) (syntax-violation #f
"source expression failed to match any pattern" tmp2351))) ($sc-dispatch
tmp2351 (quote (any #(each (any any)) any . each-any))))) x2350))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x2373) ((lambda (tmp2374) ((lambda (tmp2375)
(if tmp2375 (apply (lambda (_2376 var2377 init2378 step2379 e02380 e12381
c2382) ((lambda (tmp2383) ((lambda (tmp2384) (if tmp2384 (apply (lambda
(step2385) ((lambda (tmp2386) ((lambda (tmp2387) (if tmp2387 (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"))) (hygiene guile))) (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"))) (hygiene guile))) (map list
var2377 init2378) (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"))) (hygiene guile))) (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")))
(hygiene guile))) e02380) (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"))) (hygiene guile))) (append c2382 (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"))) (hygiene guile))) step2385))))))) tmp2387) ((lambda (tmp2392)
(if tmp2392 (apply (lambda (e12393 e22394) (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"))) (hygiene guile))) (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"))) (hygiene guile))) (map list var2377 init2378) (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"))) (hygiene guile))) e02380 (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"))) (hygiene guile)))
(cons e12393 e22394)) (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")))
(hygiene guile))) (append c2382 (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"))) (hygiene guile))) step2385))))))) tmp2392)
(syntax-violation #f "source expression failed to match any pattern" tmp2386)))
($sc-dispatch tmp2386 (quote (any . each-any)))))) ($sc-dispatch tmp2386 (quote
())))) e12381)) tmp2384) (syntax-violation #f "source expression failed to
match any pattern" tmp2383))) ($sc-dispatch tmp2383 (quote each-any)))) (map
(lambda (v2401 s2402) ((lambda (tmp2403) ((lambda (tmp2404) (if tmp2404 (apply
(lambda () v2401) tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda
(e2406) e2406) tmp2405) ((lambda (_2407) (syntax-violation (quote do) "bad step
expression" orig-x2373 s2402)) tmp2403))) ($sc-dispatch tmp2403 (quote
(any)))))) ($sc-dispatch tmp2403 (quote ())))) s2402)) var2377 step2379)))
tmp2375) (syntax-violation #f "source expression failed to match any pattern"
tmp2374))) ($sc-dispatch tmp2374 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x2373))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons2410 (lambda (x2414 y2415)
((lambda (tmp2416) ((lambda (tmp2417) (if tmp2417 (apply (lambda (x2418 y2419)
((lambda (tmp2420) ((lambda (tmp2421) (if tmp2421 (apply (lambda (dy2422)
((lambda (tmp2423) ((lambda (tmp2424) (if tmp2424 (apply (lambda (dx2425) (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"))) (hygiene guile))) (cons dx2425 dy2422))) tmp2424) ((lambda
(_2426) (if (null? dy2422) (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"))) (hygiene guile))) x2418) (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"))) (hygiene guile))) x2418 y2419))) tmp2423))) ($sc-dispatch
tmp2423 (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"))) (hygiene guile))) any))))) x2418)) tmp2421) ((lambda (tmp2427) (if
tmp2427 (apply (lambda (stuff2428) (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"))) (hygiene guile))) (cons x2418 stuff2428))) tmp2427)
((lambda (else2429) (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"))) (hygiene guile))) x2418 y2419)) tmp2420))) ($sc-dispatch tmp2420
(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"))) (hygiene guile))) . any))))))
($sc-dispatch tmp2420 (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"))) (hygiene
guile))) any))))) y2419)) tmp2417) (syntax-violation #f "source expression
failed to match any pattern" tmp2416))) ($sc-dispatch tmp2416 (quote (any
any))))) (list x2414 y2415)))) (quasiappend2411 (lambda (x2430 y2431) ((lambda
(tmp2432) ((lambda (tmp2433) (if tmp2433 (apply (lambda (x2434 y2435) ((lambda
(tmp2436) ((lambda (tmp2437) (if tmp2437 (apply (lambda () x2434) tmp2437)
((lambda (_2438) (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"))) (hygiene guile))) x2434 y2435)) tmp2436))) ($sc-dispatch tmp2436
(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"))) (hygiene guile))) ()))))) y2435))
tmp2433) (syntax-violation #f "source expression failed to match any pattern"
tmp2432))) ($sc-dispatch tmp2432 (quote (any any))))) (list x2430 y2431))))
(quasivector2412 (lambda (x2439) ((lambda (tmp2440) ((lambda (x2441) ((lambda
(tmp2442) ((lambda (tmp2443) (if tmp2443 (apply (lambda (x2444) (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"))) (hygiene guile))) (list->vector
x2444))) tmp2443) ((lambda (tmp2446) (if tmp2446 (apply (lambda (x2447) (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"))) (hygiene guile))) x2447)) tmp2446)
((lambda (_2449) (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")))
(hygiene guile))) x2441)) tmp2442))) ($sc-dispatch tmp2442 (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")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp2442 (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")))
(hygiene guile))) each-any))))) x2441)) tmp2440)) x2439))) (quasi2413 (lambda
(p2450 lev2451) ((lambda (tmp2452) ((lambda (tmp2453) (if tmp2453 (apply
(lambda (p2454) (if (= lev2451 0) p2454 (quasicons2410 (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"))) (hygiene guile))
#(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")))
(hygiene guile)))) (quasi2413 (list p2454) (- lev2451 1))))) tmp2453) ((lambda
(tmp2455) (if tmp2455 (apply (lambda (p2456 q2457) (if (= lev2451 0)
(quasiappend2411 p2456 (quasi2413 q2457 lev2451)) (quasicons2410 (quasicons2410
(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"))) (hygiene guile)) #(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"))) (hygiene guile))))
(quasi2413 (list p2456) (- lev2451 1))) (quasi2413 q2457 lev2451)))) tmp2455)
((lambda (tmp2458) (if tmp2458 (apply (lambda (p2459) (quasicons2410 (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")))
(hygiene guile)) #(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"))) (hygiene guile)))) (quasi2413 (list p2459) (+ lev2451
1)))) tmp2458) ((lambda (tmp2460) (if tmp2460 (apply (lambda (p2461 q2462)
(quasicons2410 (quasi2413 p2461 lev2451) (quasi2413 q2462 lev2451))) tmp2460)
((lambda (tmp2463) (if tmp2463 (apply (lambda (x2464) (quasivector2412
(quasi2413 x2464 lev2451))) tmp2463) ((lambda (p2466) (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")))
(hygiene guile))) p2466)) tmp2452))) ($sc-dispatch tmp2452 (quote #(vector
each-any)))))) ($sc-dispatch tmp2452 (quote (any . any)))))) ($sc-dispatch
tmp2452 (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"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp2452 (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"))) (hygiene guile))) any) . any))))))
($sc-dispatch tmp2452 (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"))) (hygiene guile))) any))))) p2450)))) (lambda (x2467) ((lambda
(tmp2468) ((lambda (tmp2469) (if tmp2469 (apply (lambda (_2470 e2471)
(quasi2413 e2471 0)) tmp2469) (syntax-violation #f "source expression failed to
match any pattern" tmp2468))) ($sc-dispatch tmp2468 (quote (any any)))))
x2467)))))
-(define include (make-syncase-macro (quote macro) (lambda (x2472) (letrec
((read-file2473 (lambda (fn2474 k2475) (let ((p2476 (open-input-file fn2474)))
(let f2477 ((x2478 (read p2476))) (if (eof-object? x2478) (begin
(close-input-port p2476) (quote ())) (cons (datum->syntax k2475 x2478) (f2477
(read p2476))))))))) ((lambda (tmp2479) ((lambda (tmp2480) (if tmp2480 (apply
(lambda (k2481 filename2482) (let ((fn2483 (syntax->datum filename2482)))
((lambda (tmp2484) ((lambda (tmp2485) (if tmp2485 (apply (lambda (exp2486)
(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"))) (hygiene guile))) exp2486))
tmp2485) (syntax-violation #f "source expression failed to match any pattern"
tmp2484))) ($sc-dispatch tmp2484 (quote each-any)))) (read-file2473 fn2483
k2481)))) tmp2480) (syntax-violation #f "source expression failed to match any
pattern" tmp2479))) ($sc-dispatch tmp2479 (quote (any any))))) x2472)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x2488) ((lambda
(tmp2489) ((lambda (tmp2490) (if tmp2490 (apply (lambda (_2491 e2492) (error
(quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum
e2492))) tmp2490) (syntax-violation #f "source expression failed to match any
pattern" tmp2489))) ($sc-dispatch tmp2489 (quote (any any))))) x2488))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2493)
((lambda (tmp2494) ((lambda (tmp2495) (if tmp2495 (apply (lambda (_2496 e2497)
(error (quote unquote-splicing) "expression ,@~s not valid outside of
quasiquote" (syntax->datum e2497))) tmp2495) (syntax-violation #f "source
expression failed to match any pattern" tmp2494))) ($sc-dispatch tmp2494 (quote
(any any))))) x2493))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x2498) ((lambda (tmp2499) ((lambda (tmp2500) (if
tmp2500 (apply (lambda (_2501 e2502 m12503 m22504) ((lambda (tmp2505) ((lambda
(body2506) (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"))) (hygiene guile))) (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"))) (hygiene guile))) e2502)) body2506))
tmp2505)) (let f2507 ((clause2508 m12503) (clauses2509 m22504)) (if (null?
clauses2509) ((lambda (tmp2511) ((lambda (tmp2512) (if tmp2512 (apply (lambda
(e12513 e22514) (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")))
(hygiene guile))) (cons e12513 e22514))) tmp2512) ((lambda (tmp2516) (if
tmp2516 (apply (lambda (k2517 e12518 e22519) (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"))) (hygiene guile))) (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"))) (hygiene guile)))
(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"))) (hygiene
guile))) (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")))
(hygiene guile))) k2517)) (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"))) (hygiene guile))) (cons e12518 e22519)))) tmp2516)
((lambda (_2522) (syntax-violation (quote case) "bad clause" x2498 clause2508))
tmp2511))) ($sc-dispatch tmp2511 (quote (each-any any . each-any))))))
($sc-dispatch tmp2511 (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"))) (hygiene guile))) any .
each-any))))) clause2508) ((lambda (tmp2523) ((lambda (rest2524) ((lambda
(tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (k2527 e12528 e22529)
(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"))) (hygiene guile))) (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")))
(hygiene guile))) (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"))) (hygiene guile))) (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"))) (hygiene guile))) k2527)) (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"))) (hygiene guile))) (cons e12528 e22529)) rest2524)) tmp2526)
((lambda (_2532) (syntax-violation (quote case) "bad clause" x2498 clause2508))
tmp2525))) ($sc-dispatch tmp2525 (quote (each-any any . each-any)))))
clause2508)) tmp2523)) (f2507 (car clauses2509) (cdr clauses2509)))))))
tmp2500) (syntax-violation #f "source expression failed to match any pattern"
tmp2499))) ($sc-dispatch tmp2499 (quote (any any any . each-any))))) x2498))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2533)
((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply (lambda (_2536 e2537)
(list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list
(quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
e2537)) (list (cons _2536 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e2537 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)))))))))) tmp2535) (syntax-violation #f "source expression failed to
match any pattern" tmp2534))) ($sc-dispatch tmp2534 (quote (any any)))))
x2533))))
+(letrec ((and-map*17 (lambda (f57 first56 . rest55) (or (null? first56) (if
(null? rest55) (let andmap58 ((first59 first56)) (let ((x60 (car first59))
(first61 (cdr first59))) (if (null? first61) (f57 x60) (and (f57 x60) (andmap58
first61))))) (let andmap62 ((first63 first56) (rest64 rest55)) (let ((x65 (car
first63)) (xr66 (map car rest64)) (first67 (cdr first63)) (rest68 (map cdr
rest64))) (if (null? first67) (apply f57 (cons x65 xr66)) (and (apply f57 (cons
x65 xr66)) (andmap62 first67 rest68)))))))))) (letrec ((lambda-var-list150
(lambda (vars355) (let lvl356 ((vars357 vars355) (ls358 (quote ())) (w359
(quote (())))) (cond ((pair? vars357) (lvl356 (cdr vars357) (cons (wrap129 (car
vars357) w359 #f) ls358) w359)) ((id?101 vars357) (cons (wrap129 vars357 w359
#f) ls358)) ((null? vars357) ls358) ((syntax-object?85 vars357) (lvl356
(syntax-object-expression86 vars357) ls358 (join-wraps120 w359
(syntax-object-wrap87 vars357)))) ((annotation? vars357) (lvl356
(annotation-expression vars357) ls358 w359)) (else (cons vars357 ls358))))))
(gen-var149 (lambda (id360) (let ((id361 (if (syntax-object?85 id360)
(syntax-object-expression86 id360) id360))) (if (annotation? id361)
(build-annotated78 (annotation-source id361) (gensym (symbol->string
(annotation-expression id361)))) (build-annotated78 #f (gensym (symbol->string
id361))))))) (strip148 (lambda (x362 w363) (if (memq (quote top) (wrap-marks104
w363)) (if (or (annotation? x362) (and (pair? x362) (annotation? (car x362))))
(strip-annotation147 x362 #f) x362) (let f364 ((x365 x362)) (cond
((syntax-object?85 x365) (strip148 (syntax-object-expression86 x365)
(syntax-object-wrap87 x365))) ((pair? x365) (let ((a366 (f364 (car x365)))
(d367 (f364 (cdr x365)))) (if (and (eq? a366 (car x365)) (eq? d367 (cdr x365)))
x365 (cons a366 d367)))) ((vector? x365) (let ((old368 (vector->list x365)))
(let ((new369 (map f364 old368))) (if (and-map*17 eq? old368 new369) x365
(list->vector new369))))) (else x365)))))) (strip-annotation147 (lambda (x370
parent371) (cond ((pair? x370) (let ((new372 (cons #f #f))) (begin (if
parent371 (set-annotation-stripped! parent371 new372)) (set-car! new372
(strip-annotation147 (car x370) #f)) (set-cdr! new372 (strip-annotation147 (cdr
x370) #f)) new372))) ((annotation? x370) (or (annotation-stripped x370)
(strip-annotation147 (annotation-expression x370) x370))) ((vector? x370) (let
((new373 (make-vector (vector-length x370)))) (begin (if parent371
(set-annotation-stripped! parent371 new373)) (let loop374 ((i375 (-
(vector-length x370) 1))) (unless (fx<73 i375 0) (vector-set! new373 i375
(strip-annotation147 (vector-ref x370 i375) #f)) (loop374 (fx-71 i375 1))))
new373))) (else x370)))) (ellipsis?146 (lambda (x376) (and (nonsymbol-id?100
x376) (free-id=?124 x376 (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-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object 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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))))))
(chi-void145 (lambda () (build-annotated78 #f (list (build-annotated78 #f
(quote void)))))) (eval-local-transformer144 (lambda (expanded377 mod378) (let
((p379 (local-eval-hook75 expanded377 mod378))) (if (procedure? p379) p379
(syntax-violation #f "nonprocedure transformer" p379))))) (chi-local-syntax143
(lambda (rec?380 e381 r382 w383 s384 mod385 k386) ((lambda (tmp387) ((lambda
(tmp388) (if tmp388 (apply (lambda (_389 id390 val391 e1392 e2393) (let
((ids394 id390)) (if (not (valid-bound-ids?126 ids394)) (syntax-violation #f
"duplicate bound keyword" e381) (let ((labels396 (gen-labels107 ids394))) (let
((new-w397 (make-binding-wrap118 ids394 labels396 w383))) (k386 (cons e1392
e2393) (extend-env95 labels396 (let ((w399 (if rec?380 new-w397 w383))
(trans-r400 (macros-only-env97 r382))) (map (lambda (x401) (cons (quote macro)
(eval-local-transformer144 (chi137 x401 trans-r400 w399 mod385) mod385)))
val391)) r382) new-w397 s384 mod385)))))) tmp388) ((lambda (_403)
(syntax-violation #f "bad local syntax definition" (source-wrap130 e381 w383
s384 mod385))) tmp387))) ($sc-dispatch tmp387 (quote (any #(each (any any)) any
. each-any))))) e381))) (chi-lambda-clause142 (lambda (e404 docstring405 c406
r407 w408 mod409 k410) ((lambda (tmp411) ((lambda (tmp412) (if (if tmp412
(apply (lambda (args413 doc414 e1415 e2416) (and (string? (syntax->datum
doc414)) (not docstring405))) tmp412) #f) (apply (lambda (args417 doc418 e1419
e2420) (chi-lambda-clause142 e404 doc418 (cons args417 (cons e1419 e2420)) r407
w408 mod409 k410)) tmp412) ((lambda (tmp422) (if tmp422 (apply (lambda (id423
e1424 e2425) (let ((ids426 id423)) (if (not (valid-bound-ids?126 ids426))
(syntax-violation (quote lambda) "invalid parameter list" e404) (let
((labels428 (gen-labels107 ids426)) (new-vars429 (map gen-var149 ids426)))
(k410 new-vars429 docstring405 (chi-body141 (cons e1424 e2425) e404
(extend-var-env96 labels428 new-vars429 r407) (make-binding-wrap118 ids426
labels428 w408) mod409)))))) tmp422) ((lambda (tmp431) (if tmp431 (apply
(lambda (ids432 e1433 e2434) (let ((old-ids435 (lambda-var-list150 ids432)))
(if (not (valid-bound-ids?126 old-ids435)) (syntax-violation (quote lambda)
"invalid parameter list" e404) (let ((labels436 (gen-labels107 old-ids435))
(new-vars437 (map gen-var149 old-ids435))) (k410 (let f438 ((ls1439 (cdr
new-vars437)) (ls2440 (car new-vars437))) (if (null? ls1439) ls2440 (f438 (cdr
ls1439) (cons (car ls1439) ls2440)))) docstring405 (chi-body141 (cons e1433
e2434) e404 (extend-var-env96 labels436 new-vars437 r407) (make-binding-wrap118
old-ids435 labels436 w408) mod409)))))) tmp431) ((lambda (_442)
(syntax-violation (quote lambda) "bad lambda" e404)) tmp411))) ($sc-dispatch
tmp411 (quote (any any . each-any)))))) ($sc-dispatch tmp411 (quote (each-any
any . each-any)))))) ($sc-dispatch tmp411 (quote (any any any . each-any)))))
c406))) (chi-body141 (lambda (body443 outer-form444 r445 w446 mod447) (let
((r448 (cons (quote ("placeholder" placeholder)) r445))) (let ((ribcage449
(make-ribcage108 (quote ()) (quote ()) (quote ())))) (let ((w450 (make-wrap103
(wrap-marks104 w446) (cons ribcage449 (wrap-subst105 w446))))) (let parse451
((body452 (map (lambda (x458) (cons r448 (wrap129 x458 w450 mod447))) body443))
(ids453 (quote ())) (labels454 (quote ())) (vars455 (quote ())) (vals456 (quote
())) (bindings457 (quote ()))) (if (null? body452) (syntax-violation #f "no
expressions in body" outer-form444) (let ((e459 (cdar body452)) (er460 (caar
body452))) (call-with-values (lambda () (syntax-type135 e459 er460 (quote (()))
#f ribcage449 mod447)) (lambda (type461 value462 e463 w464 s465 mod466) (let
((t467 type461)) (if (memv t467 (quote (define-form))) (let ((id468 (wrap129
value462 w464 mod466)) (label469 (gen-label106))) (let ((var470 (gen-var149
id468))) (begin (extend-ribcage!117 ribcage449 id468 label469) (parse451 (cdr
body452) (cons id468 ids453) (cons label469 labels454) (cons var470 vars455)
(cons (cons er460 (wrap129 e463 w464 mod466)) vals456) (cons (cons (quote
lexical) var470) bindings457))))) (if (memv t467 (quote (define-syntax-form)))
(let ((id471 (wrap129 value462 w464 mod466)) (label472 (gen-label106))) (begin
(extend-ribcage!117 ribcage449 id471 label472) (parse451 (cdr body452) (cons
id471 ids453) (cons label472 labels454) vars455 vals456 (cons (cons (quote
macro) (cons er460 (wrap129 e463 w464 mod466))) bindings457)))) (if (memv t467
(quote (begin-form))) ((lambda (tmp473) ((lambda (tmp474) (if tmp474 (apply
(lambda (_475 e1476) (parse451 (let f477 ((forms478 e1476)) (if (null?
forms478) (cdr body452) (cons (cons er460 (wrap129 (car forms478) w464 mod466))
(f477 (cdr forms478))))) ids453 labels454 vars455 vals456 bindings457)) tmp474)
(syntax-violation #f "source expression failed to match any pattern" tmp473)))
($sc-dispatch tmp473 (quote (any . each-any))))) e463) (if (memv t467 (quote
(local-syntax-form))) (chi-local-syntax143 value462 e463 er460 w464 s465 mod466
(lambda (forms480 er481 w482 s483 mod484) (parse451 (let f485 ((forms486
forms480)) (if (null? forms486) (cdr body452) (cons (cons er481 (wrap129 (car
forms486) w482 mod484)) (f485 (cdr forms486))))) ids453 labels454 vars455
vals456 bindings457))) (if (null? ids453) (build-sequence80 #f (map (lambda
(x487) (chi137 (cdr x487) (car x487) (quote (())) mod466)) (cons (cons er460
(source-wrap130 e463 w464 s465 mod466)) (cdr body452)))) (begin (if (not
(valid-bound-ids?126 ids453)) (syntax-violation #f "invalid or duplicate
identifier in definition" outer-form444)) (let loop488 ((bs489 bindings457)
(er-cache490 #f) (r-cache491 #f)) (if (not (null? bs489)) (let ((b492 (car
bs489))) (if (eq? (car b492) (quote macro)) (let ((er493 (cadr b492))) (let
((r-cache494 (if (eq? er493 er-cache490) r-cache491 (macros-only-env97
er493)))) (begin (set-cdr! b492 (eval-local-transformer144 (chi137 (cddr b492)
r-cache494 (quote (())) mod466) mod466)) (loop488 (cdr bs489) er493
r-cache494)))) (loop488 (cdr bs489) er-cache490 r-cache491))))) (set-cdr! r448
(extend-env95 labels454 bindings457 (cdr r448))) (build-letrec83 #f vars455
(map (lambda (x495) (chi137 (cdr x495) (car x495) (quote (())) mod466))
vals456) (build-sequence80 #f (map (lambda (x496) (chi137 (cdr x496) (car x496)
(quote (())) mod466)) (cons (cons er460 (source-wrap130 e463 w464 s465 mod466))
(cdr body452)))))))))))))))))))))) (chi-macro140 (lambda (p497 e498 r499 w500
rib501 mod502) (letrec ((rebuild-macro-output503 (lambda (x504 m505) (cond
((pair? x504) (cons (rebuild-macro-output503 (car x504) m505)
(rebuild-macro-output503 (cdr x504) m505))) ((syntax-object?85 x504) (let
((w506 (syntax-object-wrap87 x504))) (let ((ms507 (wrap-marks104 w506)) (s508
(wrap-subst105 w506))) (if (and (pair? ms507) (eq? (car ms507) #f))
(make-syntax-object84 (syntax-object-expression86 x504) (make-wrap103 (cdr
ms507) (if rib501 (cons rib501 (cdr s508)) (cdr s508))) (syntax-object-module88
x504)) (make-syntax-object84 (syntax-object-expression86 x504) (make-wrap103
(cons m505 ms507) (if rib501 (cons rib501 (cons (quote shift) s508)) (cons
(quote shift) s508))) (let ((pmod509 (procedure-module p497))) (if pmod509
(cons (quote hygiene) (module-name pmod509)) (quote (hygiene guile)))))))))
((vector? x504) (let ((n510 (vector-length x504))) (let ((v511 (make-vector
n510))) (let doloop512 ((i513 0)) (if (fx=72 i513 n510) v511 (begin
(vector-set! v511 i513 (rebuild-macro-output503 (vector-ref x504 i513) m505))
(doloop512 (fx+70 i513 1)))))))) ((symbol? x504) (syntax-violation #f
"encountered raw symbol in macro output" (source-wrap130 e498 w500 s mod502)
x504)) (else x504))))) (rebuild-macro-output503 (p497 (wrap129 e498
(anti-mark116 w500) mod502)) (string #\m))))) (chi-application139 (lambda (x514
e515 r516 w517 s518 mod519) ((lambda (tmp520) ((lambda (tmp521) (if tmp521
(apply (lambda (e0522 e1523) (build-annotated78 s518 (cons x514 (map (lambda
(e524) (chi137 e524 r516 w517 mod519)) e1523)))) tmp521) (syntax-violation #f
"source expression failed to match any pattern" tmp520))) ($sc-dispatch tmp520
(quote (any . each-any))))) e515))) (chi-expr138 (lambda (type526 value527 e528
r529 w530 s531 mod532) (let ((t533 type526)) (if (memv t533 (quote (lexical)))
(build-annotated78 s531 value527) (if (memv t533 (quote (core external-macro)))
(value527 e528 r529 w530 s531 mod532) (if (memv t533 (quote (module-ref)))
(call-with-values (lambda () (value527 e528)) (lambda (id534 mod535)
(build-annotated78 s531 (if mod535 (make-module-ref (cdr mod535) id534 (car
mod535)) (make-module-ref mod535 id534 (quote bare)))))) (if (memv t533 (quote
(lexical-call))) (chi-application139 (build-annotated78 (source-annotation92
(car e528)) value527) e528 r529 w530 s531 mod532) (if (memv t533 (quote
(global-call))) (chi-application139 (build-annotated78 (source-annotation92
(car e528)) (if (if (syntax-object?85 (car e528)) (syntax-object-module88 (car
e528)) mod532) (make-module-ref (cdr (if (syntax-object?85 (car e528))
(syntax-object-module88 (car e528)) mod532)) value527 (car (if
(syntax-object?85 (car e528)) (syntax-object-module88 (car e528)) mod532)))
(make-module-ref (if (syntax-object?85 (car e528)) (syntax-object-module88 (car
e528)) mod532) value527 (quote bare)))) e528 r529 w530 s531 mod532) (if (memv
t533 (quote (constant))) (build-data79 s531 (strip148 (source-wrap130 e528 w530
s531 mod532) (quote (())))) (if (memv t533 (quote (global))) (build-annotated78
s531 (if mod532 (make-module-ref (cdr mod532) value527 (car mod532))
(make-module-ref mod532 value527 (quote bare)))) (if (memv t533 (quote (call)))
(chi-application139 (chi137 (car e528) r529 w530 mod532) e528 r529 w530 s531
mod532) (if (memv t533 (quote (begin-form))) ((lambda (tmp536) ((lambda
(tmp537) (if tmp537 (apply (lambda (_538 e1539 e2540) (chi-sequence131 (cons
e1539 e2540) r529 w530 s531 mod532)) tmp537) (syntax-violation #f "source
expression failed to match any pattern" tmp536))) ($sc-dispatch tmp536 (quote
(any any . each-any))))) e528) (if (memv t533 (quote (local-syntax-form)))
(chi-local-syntax143 value527 e528 r529 w530 s531 mod532 chi-sequence131) (if
(memv t533 (quote (eval-when-form))) ((lambda (tmp542) ((lambda (tmp543) (if
tmp543 (apply (lambda (_544 x545 e1546 e2547) (let ((when-list548
(chi-when-list134 e528 x545 w530))) (if (memq (quote eval) when-list548)
(chi-sequence131 (cons e1546 e2547) r529 w530 s531 mod532) (chi-void145))))
tmp543) (syntax-violation #f "source expression failed to match any pattern"
tmp542))) ($sc-dispatch tmp542 (quote (any each-any any . each-any))))) e528)
(if (memv t533 (quote (define-form define-syntax-form))) (syntax-violation #f
"definition in expression context" e528 (wrap129 value527 w530 mod532)) (if
(memv t533 (quote (syntax))) (syntax-violation #f "reference to pattern
variable outside syntax form" (source-wrap130 e528 w530 s531 mod532)) (if (memv
t533 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier
outside its scope" (source-wrap130 e528 w530 s531 mod532)) (syntax-violation #f
"unexpected syntax" (source-wrap130 e528 w530 s531 mod532)))))))))))))))))))
(chi137 (lambda (e551 r552 w553 mod554) (call-with-values (lambda ()
(syntax-type135 e551 r552 w553 #f #f mod554)) (lambda (type555 value556 e557
w558 s559 mod560) (chi-expr138 type555 value556 e557 r552 w558 s559 mod560)))))
(chi-top136 (lambda (e561 r562 w563 m564 esew565 mod566) (call-with-values
(lambda () (syntax-type135 e561 r562 w563 #f #f mod566)) (lambda (type574
value575 e576 w577 s578 mod579) (let ((t580 type574)) (if (memv t580 (quote
(begin-form))) ((lambda (tmp581) ((lambda (tmp582) (if tmp582 (apply (lambda
(_583) (chi-void145)) tmp582) ((lambda (tmp584) (if tmp584 (apply (lambda (_585
e1586 e2587) (chi-top-sequence132 (cons e1586 e2587) r562 w577 s578 m564
esew565 mod579)) tmp584) (syntax-violation #f "source expression failed to
match any pattern" tmp581))) ($sc-dispatch tmp581 (quote (any any .
each-any)))))) ($sc-dispatch tmp581 (quote (any))))) e576) (if (memv t580
(quote (local-syntax-form))) (chi-local-syntax143 value575 e576 r562 w577 s578
mod579 (lambda (body589 r590 w591 s592 mod593) (chi-top-sequence132 body589
r590 w591 s592 m564 esew565 mod593))) (if (memv t580 (quote (eval-when-form)))
((lambda (tmp594) ((lambda (tmp595) (if tmp595 (apply (lambda (_596 x597 e1598
e2599) (let ((when-list600 (chi-when-list134 e576 x597 w577)) (body601 (cons
e1598 e2599))) (cond ((eq? m564 (quote e)) (if (memq (quote eval) when-list600)
(chi-top-sequence132 body601 r562 w577 s578 (quote e) (quote (eval)) mod579)
(chi-void145))) ((memq (quote load) when-list600) (if (or (memq (quote compile)
when-list600) (and (eq? m564 (quote c&e)) (memq (quote eval) when-list600)))
(chi-top-sequence132 body601 r562 w577 s578 (quote c&e) (quote (compile load))
mod579) (if (memq m564 (quote (c c&e))) (chi-top-sequence132 body601 r562 w577
s578 (quote c) (quote (load)) mod579) (chi-void145)))) ((or (memq (quote
compile) when-list600) (and (eq? m564 (quote c&e)) (memq (quote eval)
when-list600))) (top-level-eval-hook74 (chi-top-sequence132 body601 r562 w577
s578 (quote e) (quote (eval)) mod579) mod579) (chi-void145)) (else
(chi-void145))))) tmp595) (syntax-violation #f "source expression failed to
match any pattern" tmp594))) ($sc-dispatch tmp594 (quote (any each-any any .
each-any))))) e576) (if (memv t580 (quote (define-syntax-form))) (let ((n604
(id-var-name123 value575 w577)) (r605 (macros-only-env97 r562))) (let ((t606
m564)) (if (memv t606 (quote (c))) (if (memq (quote compile) esew565) (let
((e607 (chi-install-global133 n604 (chi137 e576 r605 w577 mod579)))) (begin
(top-level-eval-hook74 e607 mod579) (if (memq (quote load) esew565) e607
(chi-void145)))) (if (memq (quote load) esew565) (chi-install-global133 n604
(chi137 e576 r605 w577 mod579)) (chi-void145))) (if (memv t606 (quote (c&e)))
(let ((e608 (chi-install-global133 n604 (chi137 e576 r605 w577 mod579))))
(begin (top-level-eval-hook74 e608 mod579) e608)) (begin (if (memq (quote eval)
esew565) (top-level-eval-hook74 (chi-install-global133 n604 (chi137 e576 r605
w577 mod579)) mod579)) (chi-void145)))))) (if (memv t580 (quote (define-form)))
(let ((n609 (id-var-name123 value575 w577))) (let ((type610 (binding-type93
(lookup98 n609 r562 mod579)))) (let ((t611 type610)) (if (memv t611 (quote
(global core macro module-ref))) (let ((x612 (build-annotated78 s578 (list
(quote define) n609 (chi137 e576 r562 w577 mod579))))) (begin (if (eq? m564
(quote c&e)) (top-level-eval-hook74 x612 mod579)) x612)) (if (memv t611 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e576
(wrap129 value575 w577 mod579)) (syntax-violation #f "cannot define keyword at
top level" e576 (wrap129 value575 w577 mod579))))))) (let ((x613 (chi-expr138
type574 value575 e576 r562 w577 s578 mod579))) (begin (if (eq? m564 (quote
c&e)) (top-level-eval-hook74 x613 mod579)) x613)))))))))))) (syntax-type135
(lambda (e614 r615 w616 s617 rib618 mod619) (cond ((symbol? e614) (let ((n620
(id-var-name123 e614 w616))) (let ((b621 (lookup98 n620 r615 mod619))) (let
((type622 (binding-type93 b621))) (let ((t623 type622)) (if (memv t623 (quote
(lexical))) (values type622 (binding-value94 b621) e614 w616 s617 mod619) (if
(memv t623 (quote (global))) (values type622 n620 e614 w616 s617 mod619) (if
(memv t623 (quote (macro))) (syntax-type135 (chi-macro140 (binding-value94
b621) e614 r615 w616 rib618 mod619) r615 (quote (())) s617 rib618 mod619)
(values type622 (binding-value94 b621) e614 w616 s617 mod619))))))))) ((pair?
e614) (let ((first624 (car e614))) (if (id?101 first624) (let ((n625
(id-var-name123 first624 w616))) (let ((b626 (lookup98 n625 r615 (or (and
(syntax-object?85 first624) (syntax-object-module88 first624)) mod619)))) (let
((type627 (binding-type93 b626))) (let ((t628 type627)) (if (memv t628 (quote
(lexical))) (values (quote lexical-call) (binding-value94 b626) e614 w616 s617
mod619) (if (memv t628 (quote (global))) (values (quote global-call) n625 e614
w616 s617 mod619) (if (memv t628 (quote (macro))) (syntax-type135 (chi-macro140
(binding-value94 b626) e614 r615 w616 rib618 mod619) r615 (quote (())) s617
rib618 mod619) (if (memv t628 (quote (core external-macro module-ref))) (values
type627 (binding-value94 b626) e614 w616 s617 mod619) (if (memv t628 (quote
(local-syntax))) (values (quote local-syntax-form) (binding-value94 b626) e614
w616 s617 mod619) (if (memv t628 (quote (begin))) (values (quote begin-form) #f
e614 w616 s617 mod619) (if (memv t628 (quote (eval-when))) (values (quote
eval-when-form) #f e614 w616 s617 mod619) (if (memv t628 (quote (define)))
((lambda (tmp629) ((lambda (tmp630) (if (if tmp630 (apply (lambda (_631 name632
val633) (id?101 name632)) tmp630) #f) (apply (lambda (_634 name635 val636)
(values (quote define-form) name635 val636 w616 s617 mod619)) tmp630) ((lambda
(tmp637) (if (if tmp637 (apply (lambda (_638 name639 args640 e1641 e2642) (and
(id?101 name639) (valid-bound-ids?126 (lambda-var-list150 args640)))) tmp637)
#f) (apply (lambda (_643 name644 args645 e1646 e2647) (values (quote
define-form) (wrap129 name644 w616 mod619) (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 mod)
#((top) (top) (top) (top) (top) (top)) #("i" "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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
(wrap129 (cons args645 (cons e1646 e2647)) w616 mod619)) (quote (())) s617
mod619)) tmp637) ((lambda (tmp649) (if (if tmp649 (apply (lambda (_650 name651)
(id?101 name651)) tmp649) #f) (apply (lambda (_652 name653) (values (quote
define-form) (wrap129 name653 w616 mod619) (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 mod) #((top) (top) (top) (top) (top) (top)) #("i" "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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
(())) s617 mod619)) tmp649) (syntax-violation #f "source expression failed to
match any pattern" tmp629))) ($sc-dispatch tmp629 (quote (any any))))))
($sc-dispatch tmp629 (quote (any (any . any) any . each-any)))))) ($sc-dispatch
tmp629 (quote (any any any))))) e614) (if (memv t628 (quote (define-syntax)))
((lambda (tmp654) ((lambda (tmp655) (if (if tmp655 (apply (lambda (_656 name657
val658) (id?101 name657)) tmp655) #f) (apply (lambda (_659 name660 val661)
(values (quote define-syntax-form) name660 val661 w616 s617 mod619)) tmp655)
(syntax-violation #f "source expression failed to match any pattern" tmp654)))
($sc-dispatch tmp654 (quote (any any any))))) e614) (values (quote call) #f
e614 w616 s617 mod619)))))))))))))) (values (quote call) #f e614 w616 s617
mod619)))) ((syntax-object?85 e614) (syntax-type135 (syntax-object-expression86
e614) r615 (join-wraps120 w616 (syntax-object-wrap87 e614)) #f rib618 (or
(syntax-object-module88 e614) mod619))) ((annotation? e614) (syntax-type135
(annotation-expression e614) r615 w616 (annotation-source e614) rib618 mod619))
((self-evaluating? e614) (values (quote constant) #f e614 w616 s617 mod619))
(else (values (quote other) #f e614 w616 s617 mod619))))) (chi-when-list134
(lambda (e662 when-list663 w664) (let f665 ((when-list666 when-list663)
(situations667 (quote ()))) (if (null? when-list666) situations667 (f665 (cdr
when-list666) (cons (let ((x668 (car when-list666))) (cond ((free-id=?124 x668
(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-module! set-syntax-object-wrap!
set-syntax-object-expression! syntax-object-module syntax-object-wrap
syntax-object-expression syntax-object? make-syntax-object 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 build-annotated get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top))
("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?124 x668 (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-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object 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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
load)) ((free-id=?124 x668 (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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
eval)) (else (syntax-violation (quote eval-when) "invalid situation" e662
(wrap129 x668 w664 #f))))) situations667)))))) (chi-install-global133 (lambda
(name669 e670) (build-annotated78 #f (list (build-annotated78 #f (quote
define)) name669 (if (let ((v671 (module-variable (current-module) name669)))
(and v671 (variable-bound? v671) (macro? (variable-ref v671)) (not (eq?
(macro-type (variable-ref v671)) (quote syncase-macro))))) (build-annotated78
#f (list (build-annotated78 #f (quote make-extended-syncase-macro))
(build-annotated78 #f (list (build-annotated78 #f (quote module-ref))
(build-annotated78 #f (quote (current-module))) (build-data79 #f name669)))
(build-data79 #f (quote macro)) e670)) (build-annotated78 #f (list
(build-annotated78 #f (quote make-syncase-macro)) (build-data79 #f (quote
macro)) e670))))))) (chi-top-sequence132 (lambda (body672 r673 w674 s675 m676
esew677 mod678) (build-sequence80 s675 (let dobody679 ((body680 body672) (r681
r673) (w682 w674) (m683 m676) (esew684 esew677) (mod685 mod678)) (if (null?
body680) (quote ()) (let ((first686 (chi-top136 (car body680) r681 w682 m683
esew684 mod685))) (cons first686 (dobody679 (cdr body680) r681 w682 m683
esew684 mod685)))))))) (chi-sequence131 (lambda (body687 r688 w689 s690 mod691)
(build-sequence80 s690 (let dobody692 ((body693 body687) (r694 r688) (w695
w689) (mod696 mod691)) (if (null? body693) (quote ()) (let ((first697 (chi137
(car body693) r694 w695 mod696))) (cons first697 (dobody692 (cdr body693) r694
w695 mod696)))))))) (source-wrap130 (lambda (x698 w699 s700 defmod701) (wrap129
(if s700 (make-annotation x698 s700 #f) x698) w699 defmod701))) (wrap129
(lambda (x702 w703 defmod704) (cond ((and (null? (wrap-marks104 w703)) (null?
(wrap-subst105 w703))) x702) ((syntax-object?85 x702) (make-syntax-object84
(syntax-object-expression86 x702) (join-wraps120 w703 (syntax-object-wrap87
x702)) (syntax-object-module88 x702))) ((null? x702) x702) (else
(make-syntax-object84 x702 w703 defmod704))))) (bound-id-member?128 (lambda
(x705 list706) (and (not (null? list706)) (or (bound-id=?125 x705 (car
list706)) (bound-id-member?128 x705 (cdr list706)))))) (distinct-bound-ids?127
(lambda (ids707) (let distinct?708 ((ids709 ids707)) (or (null? ids709) (and
(not (bound-id-member?128 (car ids709) (cdr ids709))) (distinct?708 (cdr
ids709))))))) (valid-bound-ids?126 (lambda (ids710) (and (let all-ids?711
((ids712 ids710)) (or (null? ids712) (and (id?101 (car ids712)) (all-ids?711
(cdr ids712))))) (distinct-bound-ids?127 ids710)))) (bound-id=?125 (lambda
(i713 j714) (if (and (syntax-object?85 i713) (syntax-object?85 j714)) (and (eq?
(let ((e715 (syntax-object-expression86 i713))) (if (annotation? e715)
(annotation-expression e715) e715)) (let ((e716 (syntax-object-expression86
j714))) (if (annotation? e716) (annotation-expression e716) e716)))
(same-marks?122 (wrap-marks104 (syntax-object-wrap87 i713)) (wrap-marks104
(syntax-object-wrap87 j714)))) (eq? (let ((e717 i713)) (if (annotation? e717)
(annotation-expression e717) e717)) (let ((e718 j714)) (if (annotation? e718)
(annotation-expression e718) e718)))))) (free-id=?124 (lambda (i719 j720) (and
(eq? (let ((x721 i719)) (let ((e722 (if (syntax-object?85 x721)
(syntax-object-expression86 x721) x721))) (if (annotation? e722)
(annotation-expression e722) e722))) (let ((x723 j720)) (let ((e724 (if
(syntax-object?85 x723) (syntax-object-expression86 x723) x723))) (if
(annotation? e724) (annotation-expression e724) e724)))) (eq? (id-var-name123
i719 (quote (()))) (id-var-name123 j720 (quote (()))))))) (id-var-name123
(lambda (id725 w726) (letrec ((search-vector-rib729 (lambda (sym735 subst736
marks737 symnames738 ribcage739) (let ((n740 (vector-length symnames738))) (let
f741 ((i742 0)) (cond ((fx=72 i742 n740) (search727 sym735 (cdr subst736)
marks737)) ((and (eq? (vector-ref symnames738 i742) sym735) (same-marks?122
marks737 (vector-ref (ribcage-marks111 ribcage739) i742))) (values (vector-ref
(ribcage-labels112 ribcage739) i742) marks737)) (else (f741 (fx+70 i742
1)))))))) (search-list-rib728 (lambda (sym743 subst744 marks745 symnames746
ribcage747) (let f748 ((symnames749 symnames746) (i750 0)) (cond ((null?
symnames749) (search727 sym743 (cdr subst744) marks745)) ((and (eq? (car
symnames749) sym743) (same-marks?122 marks745 (list-ref (ribcage-marks111
ribcage747) i750))) (values (list-ref (ribcage-labels112 ribcage747) i750)
marks745)) (else (f748 (cdr symnames749) (fx+70 i750 1))))))) (search727
(lambda (sym751 subst752 marks753) (if (null? subst752) (values #f marks753)
(let ((fst754 (car subst752))) (if (eq? fst754 (quote shift)) (search727 sym751
(cdr subst752) (cdr marks753)) (let ((symnames755 (ribcage-symnames110
fst754))) (if (vector? symnames755) (search-vector-rib729 sym751 subst752
marks753 symnames755 fst754) (search-list-rib728 sym751 subst752 marks753
symnames755 fst754))))))))) (cond ((symbol? id725) (or (call-with-values
(lambda () (search727 id725 (wrap-subst105 w726) (wrap-marks104 w726))) (lambda
(x757 . ignore756) x757)) id725)) ((syntax-object?85 id725) (let ((id758 (let
((e760 (syntax-object-expression86 id725))) (if (annotation? e760)
(annotation-expression e760) e760))) (w1759 (syntax-object-wrap87 id725))) (let
((marks761 (join-marks121 (wrap-marks104 w726) (wrap-marks104 w1759))))
(call-with-values (lambda () (search727 id758 (wrap-subst105 w726) marks761))
(lambda (new-id762 marks763) (or new-id762 (call-with-values (lambda ()
(search727 id758 (wrap-subst105 w1759) marks763)) (lambda (x765 . ignore764)
x765)) id758)))))) ((annotation? id725) (let ((id766 (let ((e767 id725)) (if
(annotation? e767) (annotation-expression e767) e767)))) (or (call-with-values
(lambda () (search727 id766 (wrap-subst105 w726) (wrap-marks104 w726))) (lambda
(x769 . ignore768) x769)) id766))) (else (syntax-violation (quote id-var-name)
"invalid id" id725)))))) (same-marks?122 (lambda (x770 y771) (or (eq? x770
y771) (and (not (null? x770)) (not (null? y771)) (eq? (car x770) (car y771))
(same-marks?122 (cdr x770) (cdr y771)))))) (join-marks121 (lambda (m1772 m2773)
(smart-append119 m1772 m2773))) (join-wraps120 (lambda (w1774 w2775) (let
((m1776 (wrap-marks104 w1774)) (s1777 (wrap-subst105 w1774))) (if (null? m1776)
(if (null? s1777) w2775 (make-wrap103 (wrap-marks104 w2775) (smart-append119
s1777 (wrap-subst105 w2775)))) (make-wrap103 (smart-append119 m1776
(wrap-marks104 w2775)) (smart-append119 s1777 (wrap-subst105 w2775)))))))
(smart-append119 (lambda (m1778 m2779) (if (null? m2779) m1778 (append m1778
m2779)))) (make-binding-wrap118 (lambda (ids780 labels781 w782) (if (null?
ids780) w782 (make-wrap103 (wrap-marks104 w782) (cons (let ((labelvec783
(list->vector labels781))) (let ((n784 (vector-length labelvec783))) (let
((symnamevec785 (make-vector n784)) (marksvec786 (make-vector n784))) (begin
(let f787 ((ids788 ids780) (i789 0)) (if (not (null? ids788)) (call-with-values
(lambda () (id-sym-name&marks102 (car ids788) w782)) (lambda (symname790
marks791) (begin (vector-set! symnamevec785 i789 symname790) (vector-set!
marksvec786 i789 marks791) (f787 (cdr ids788) (fx+70 i789 1)))))))
(make-ribcage108 symnamevec785 marksvec786 labelvec783))))) (wrap-subst105
w782)))))) (extend-ribcage!117 (lambda (ribcage792 id793 label794) (begin
(set-ribcage-symnames!113 ribcage792 (cons (let ((e795
(syntax-object-expression86 id793))) (if (annotation? e795)
(annotation-expression e795) e795)) (ribcage-symnames110 ribcage792)))
(set-ribcage-marks!114 ribcage792 (cons (wrap-marks104 (syntax-object-wrap87
id793)) (ribcage-marks111 ribcage792))) (set-ribcage-labels!115 ribcage792
(cons label794 (ribcage-labels112 ribcage792)))))) (anti-mark116 (lambda (w796)
(make-wrap103 (cons #f (wrap-marks104 w796)) (cons (quote shift) (wrap-subst105
w796))))) (set-ribcage-labels!115 (lambda (x797 update798) (vector-set! x797 3
update798))) (set-ribcage-marks!114 (lambda (x799 update800) (vector-set! x799
2 update800))) (set-ribcage-symnames!113 (lambda (x801 update802) (vector-set!
x801 1 update802))) (ribcage-labels112 (lambda (x803) (vector-ref x803 3)))
(ribcage-marks111 (lambda (x804) (vector-ref x804 2))) (ribcage-symnames110
(lambda (x805) (vector-ref x805 1))) (ribcage?109 (lambda (x806) (and (vector?
x806) (= (vector-length x806) 4) (eq? (vector-ref x806 0) (quote ribcage)))))
(make-ribcage108 (lambda (symnames807 marks808 labels809) (vector (quote
ribcage) symnames807 marks808 labels809))) (gen-labels107 (lambda (ls810) (if
(null? ls810) (quote ()) (cons (gen-label106) (gen-labels107 (cdr ls810))))))
(gen-label106 (lambda () (string #\i))) (wrap-subst105 cdr) (wrap-marks104 car)
(make-wrap103 cons) (id-sym-name&marks102 (lambda (x811 w812) (if
(syntax-object?85 x811) (values (let ((e813 (syntax-object-expression86 x811)))
(if (annotation? e813) (annotation-expression e813) e813)) (join-marks121
(wrap-marks104 w812) (wrap-marks104 (syntax-object-wrap87 x811)))) (values (let
((e814 x811)) (if (annotation? e814) (annotation-expression e814) e814))
(wrap-marks104 w812))))) (id?101 (lambda (x815) (cond ((symbol? x815) #t)
((syntax-object?85 x815) (symbol? (let ((e816 (syntax-object-expression86
x815))) (if (annotation? e816) (annotation-expression e816) e816))))
((annotation? x815) (symbol? (annotation-expression x815))) (else #f))))
(nonsymbol-id?100 (lambda (x817) (and (syntax-object?85 x817) (symbol? (let
((e818 (syntax-object-expression86 x817))) (if (annotation? e818)
(annotation-expression e818) e818)))))) (global-extend99 (lambda (type819
sym820 val821) (put-global-definition-hook76 sym820 type819 val821))) (lookup98
(lambda (x822 r823 mod824) (cond ((assq x822 r823) => cdr) ((symbol? x822) (or
(get-global-definition-hook77 x822 mod824) (quote (global)))) (else (quote
(displaced-lexical)))))) (macros-only-env97 (lambda (r825) (if (null? r825)
(quote ()) (let ((a826 (car r825))) (if (eq? (cadr a826) (quote macro)) (cons
a826 (macros-only-env97 (cdr r825))) (macros-only-env97 (cdr r825)))))))
(extend-var-env96 (lambda (labels827 vars828 r829) (if (null? labels827) r829
(extend-var-env96 (cdr labels827) (cdr vars828) (cons (cons (car labels827)
(cons (quote lexical) (car vars828))) r829))))) (extend-env95 (lambda
(labels830 bindings831 r832) (if (null? labels830) r832 (extend-env95 (cdr
labels830) (cdr bindings831) (cons (cons (car labels830) (car bindings831))
r832))))) (binding-value94 cdr) (binding-type93 car) (source-annotation92
(lambda (x833) (cond ((annotation? x833) (annotation-source x833))
((syntax-object?85 x833) (source-annotation92 (syntax-object-expression86
x833))) (else #f)))) (set-syntax-object-module!91 (lambda (x834 update835)
(vector-set! x834 3 update835))) (set-syntax-object-wrap!90 (lambda (x836
update837) (vector-set! x836 2 update837))) (set-syntax-object-expression!89
(lambda (x838 update839) (vector-set! x838 1 update839)))
(syntax-object-module88 (lambda (x840) (vector-ref x840 3)))
(syntax-object-wrap87 (lambda (x841) (vector-ref x841 2)))
(syntax-object-expression86 (lambda (x842) (vector-ref x842 1)))
(syntax-object?85 (lambda (x843) (and (vector? x843) (= (vector-length x843) 4)
(eq? (vector-ref x843 0) (quote syntax-object))))) (make-syntax-object84
(lambda (expression844 wrap845 module846) (vector (quote syntax-object)
expression844 wrap845 module846))) (build-letrec83 (lambda (src847 vars848
val-exps849 body-exp850) (if (null? vars848) (build-annotated78 src847
body-exp850) (build-annotated78 src847 (list (quote letrec) (map list vars848
val-exps849) body-exp850))))) (build-named-let82 (lambda (src851 vars852
val-exps853 body-exp854) (if (null? vars852) (build-annotated78 src851
body-exp854) (build-annotated78 src851 (list (quote let) (car vars852) (map
list (cdr vars852) val-exps853) body-exp854))))) (build-let81 (lambda (src855
vars856 val-exps857 body-exp858) (if (null? vars856) (build-annotated78 src855
body-exp858) (build-annotated78 src855 (list (quote let) (map list vars856
val-exps857) body-exp858))))) (build-sequence80 (lambda (src859 exps860) (if
(null? (cdr exps860)) (build-annotated78 src859 (car exps860))
(build-annotated78 src859 (cons (quote begin) exps860))))) (build-data79
(lambda (src861 exp862) (if (and (self-evaluating? exp862) (not (vector?
exp862))) (build-annotated78 src861 exp862) (build-annotated78 src861 (list
(quote quote) exp862))))) (build-annotated78 (lambda (src863 exp864) (if (and
src863 (not (annotation? exp864))) (make-annotation exp864 src863 #t) exp864)))
(get-global-definition-hook77 (lambda (symbol865 module866) (begin (if (and
(not module866) (current-module)) (warn "module system is booted, we should
have a module" symbol865)) (let ((v867 (module-variable (if module866
(resolve-module (cdr module866)) (current-module)) symbol865))) (and v867
(variable-bound? v867) (let ((val868 (variable-ref v867))) (and (macro? val868)
(syncase-macro-type val868) (cons (syncase-macro-type val868)
(syncase-macro-binding val868))))))))) (put-global-definition-hook76 (lambda
(symbol869 type870 val871) (let ((existing872 (let ((v873 (module-variable
(current-module) symbol869))) (and v873 (variable-bound? v873) (let ((val874
(variable-ref v873))) (and (macro? val874) (not (syncase-macro-type val874))
val874)))))) (module-define! (current-module) symbol869 (if existing872
(make-extended-syncase-macro existing872 type870 val871) (make-syncase-macro
type870 val871)))))) (local-eval-hook75 (lambda (x875 mod876) (primitive-eval
(list noexpand69 x875)))) (top-level-eval-hook74 (lambda (x877 mod878)
(primitive-eval (list noexpand69 x877)))) (fx<73 <) (fx=72 =) (fx-71 -) (fx+70
+) (noexpand69 "noexpand")) (begin (global-extend99 (quote local-syntax) (quote
letrec-syntax) #t) (global-extend99 (quote local-syntax) (quote let-syntax) #f)
(global-extend99 (quote core) (quote fluid-let-syntax) (lambda (e879 r880 w881
s882 mod883) ((lambda (tmp884) ((lambda (tmp885) (if (if tmp885 (apply (lambda
(_886 var887 val888 e1889 e2890) (valid-bound-ids?126 var887)) tmp885) #f)
(apply (lambda (_892 var893 val894 e1895 e2896) (let ((names897 (map (lambda
(x898) (id-var-name123 x898 w881)) var893))) (begin (for-each (lambda (id900
n901) (let ((t902 (binding-type93 (lookup98 n901 r880 mod883)))) (if (memv t902
(quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax)
"identifier out of context" e879 (source-wrap130 id900 w881 s882 mod883)))))
var893 names897) (chi-body141 (cons e1895 e2896) (source-wrap130 e879 w881 s882
mod883) (extend-env95 names897 (let ((trans-r905 (macros-only-env97 r880)))
(map (lambda (x906) (cons (quote macro) (eval-local-transformer144 (chi137 x906
trans-r905 w881 mod883) mod883))) val894)) r880) w881 mod883)))) tmp885)
((lambda (_908) (syntax-violation (quote fluid-let-syntax) "bad syntax"
(source-wrap130 e879 w881 s882 mod883))) tmp884))) ($sc-dispatch tmp884 (quote
(any #(each (any any)) any . each-any))))) e879))) (global-extend99 (quote
core) (quote quote) (lambda (e909 r910 w911 s912 mod913) ((lambda (tmp914)
((lambda (tmp915) (if tmp915 (apply (lambda (_916 e917) (build-data79 s912
(strip148 e917 w911))) tmp915) ((lambda (_918) (syntax-violation (quote quote)
"bad syntax" (source-wrap130 e909 w911 s912 mod913))) tmp914))) ($sc-dispatch
tmp914 (quote (any any))))) e909))) (global-extend99 (quote core) (quote
syntax) (letrec ((regen926 (lambda (x927) (let ((t928 (car x927))) (if (memv
t928 (quote (ref))) (build-annotated78 #f (cadr x927)) (if (memv t928 (quote
(primitive))) (build-annotated78 #f (cadr x927)) (if (memv t928 (quote
(quote))) (build-data79 #f (cadr x927)) (if (memv t928 (quote (lambda)))
(build-annotated78 #f (list (quote lambda) (cadr x927) (regen926 (caddr
x927)))) (if (memv t928 (quote (map))) (let ((ls929 (map regen926 (cdr x927))))
(build-annotated78 #f (cons (if (fx=72 (length ls929) 2) (build-annotated78 #f
(quote map)) (build-annotated78 #f (quote map))) ls929))) (build-annotated78 #f
(cons (build-annotated78 #f (car x927)) (map regen926 (cdr x927))))))))))))
(gen-vector925 (lambda (x930) (cond ((eq? (car x930) (quote list)) (cons (quote
vector) (cdr x930))) ((eq? (car x930) (quote quote)) (list (quote quote)
(list->vector (cadr x930)))) (else (list (quote list->vector) x930)))))
(gen-append924 (lambda (x931 y932) (if (equal? y932 (quote (quote ()))) x931
(list (quote append) x931 y932)))) (gen-cons923 (lambda (x933 y934) (let ((t935
(car y934))) (if (memv t935 (quote (quote))) (if (eq? (car x933) (quote quote))
(list (quote quote) (cons (cadr x933) (cadr y934))) (if (eq? (cadr y934) (quote
())) (list (quote list) x933) (list (quote cons) x933 y934))) (if (memv t935
(quote (list))) (cons (quote list) (cons x933 (cdr y934))) (list (quote cons)
x933 y934)))))) (gen-map922 (lambda (e936 map-env937) (let ((formals938 (map
cdr map-env937)) (actuals939 (map (lambda (x940) (list (quote ref) (car x940)))
map-env937))) (cond ((eq? (car e936) (quote ref)) (car actuals939)) ((and-map
(lambda (x941) (and (eq? (car x941) (quote ref)) (memq (cadr x941)
formals938))) (cdr e936)) (cons (quote map) (cons (list (quote primitive) (car
e936)) (map (let ((r942 (map cons formals938 actuals939))) (lambda (x943) (cdr
(assq (cadr x943) r942)))) (cdr e936))))) (else (cons (quote map) (cons (list
(quote lambda) formals938 e936) actuals939))))))) (gen-mappend921 (lambda (e944
map-env945) (list (quote apply) (quote (primitive append)) (gen-map922 e944
map-env945)))) (gen-ref920 (lambda (src946 var947 level948 maps949) (if (fx=72
level948 0) (values var947 maps949) (if (null? maps949) (syntax-violation
(quote syntax) "missing ellipsis" src946) (call-with-values (lambda ()
(gen-ref920 src946 var947 (fx-71 level948 1) (cdr maps949))) (lambda
(outer-var950 outer-maps951) (let ((b952 (assq outer-var950 (car maps949))))
(if b952 (values (cdr b952) maps949) (let ((inner-var953 (gen-var149 (quote
tmp)))) (values inner-var953 (cons (cons (cons outer-var950 inner-var953) (car
maps949)) outer-maps951))))))))))) (gen-syntax919 (lambda (src954 e955 r956
maps957 ellipsis?958 mod959) (if (id?101 e955) (let ((label960 (id-var-name123
e955 (quote (()))))) (let ((b961 (lookup98 label960 r956 mod959))) (if (eq?
(binding-type93 b961) (quote syntax)) (call-with-values (lambda () (let
((var.lev962 (binding-value94 b961))) (gen-ref920 src954 (car var.lev962) (cdr
var.lev962) maps957))) (lambda (var963 maps964) (values (list (quote ref)
var963) maps964))) (if (ellipsis?958 e955) (syntax-violation (quote syntax)
"misplaced ellipsis" src954) (values (list (quote quote) e955) maps957)))))
((lambda (tmp965) ((lambda (tmp966) (if (if tmp966 (apply (lambda (dots967
e968) (ellipsis?958 dots967)) tmp966) #f) (apply (lambda (dots969 e970)
(gen-syntax919 src954 e970 r956 maps957 (lambda (x971) #f) mod959)) tmp966)
((lambda (tmp972) (if (if tmp972 (apply (lambda (x973 dots974 y975)
(ellipsis?958 dots974)) tmp972) #f) (apply (lambda (x976 dots977 y978) (let
f979 ((y980 y978) (k981 (lambda (maps982) (call-with-values (lambda ()
(gen-syntax919 src954 x976 r956 (cons (quote ()) maps982) ellipsis?958 mod959))
(lambda (x983 maps984) (if (null? (car maps984)) (syntax-violation (quote
syntax) "extra ellipsis" src954) (values (gen-map922 x983 (car maps984)) (cdr
maps984)))))))) ((lambda (tmp985) ((lambda (tmp986) (if (if tmp986 (apply
(lambda (dots987 y988) (ellipsis?958 dots987)) tmp986) #f) (apply (lambda
(dots989 y990) (f979 y990 (lambda (maps991) (call-with-values (lambda () (k981
(cons (quote ()) maps991))) (lambda (x992 maps993) (if (null? (car maps993))
(syntax-violation (quote syntax) "extra ellipsis" src954) (values
(gen-mappend921 x992 (car maps993)) (cdr maps993)))))))) tmp986) ((lambda
(_994) (call-with-values (lambda () (gen-syntax919 src954 y980 r956 maps957
ellipsis?958 mod959)) (lambda (y995 maps996) (call-with-values (lambda () (k981
maps996)) (lambda (x997 maps998) (values (gen-append924 x997 y995)
maps998)))))) tmp985))) ($sc-dispatch tmp985 (quote (any . any))))) y980)))
tmp972) ((lambda (tmp999) (if tmp999 (apply (lambda (x1000 y1001)
(call-with-values (lambda () (gen-syntax919 src954 x1000 r956 maps957
ellipsis?958 mod959)) (lambda (x1002 maps1003) (call-with-values (lambda ()
(gen-syntax919 src954 y1001 r956 maps1003 ellipsis?958 mod959)) (lambda (y1004
maps1005) (values (gen-cons923 x1002 y1004) maps1005)))))) tmp999) ((lambda
(tmp1006) (if tmp1006 (apply (lambda (e11007 e21008) (call-with-values (lambda
() (gen-syntax919 src954 (cons e11007 e21008) r956 maps957 ellipsis?958
mod959)) (lambda (e1010 maps1011) (values (gen-vector925 e1010) maps1011))))
tmp1006) ((lambda (_1012) (values (list (quote quote) e955) maps957)) tmp965)))
($sc-dispatch tmp965 (quote #(vector (any . each-any))))))) ($sc-dispatch
tmp965 (quote (any . any)))))) ($sc-dispatch tmp965 (quote (any any . any))))))
($sc-dispatch tmp965 (quote (any any))))) e955))))) (lambda (e1013 r1014 w1015
s1016 mod1017) (let ((e1018 (source-wrap130 e1013 w1015 s1016 mod1017)))
((lambda (tmp1019) ((lambda (tmp1020) (if tmp1020 (apply (lambda (_1021 x1022)
(call-with-values (lambda () (gen-syntax919 e1018 x1022 r1014 (quote ())
ellipsis?146 mod1017)) (lambda (e1023 maps1024) (regen926 e1023)))) tmp1020)
((lambda (_1025) (syntax-violation (quote syntax) "bad `syntax' form" e1018))
tmp1019))) ($sc-dispatch tmp1019 (quote (any any))))) e1018)))))
(global-extend99 (quote core) (quote lambda) (lambda (e1026 r1027 w1028 s1029
mod1030) ((lambda (tmp1031) ((lambda (tmp1032) (if tmp1032 (apply (lambda
(_1033 c1034) (chi-lambda-clause142 (source-wrap130 e1026 w1028 s1029 mod1030)
#f c1034 r1027 w1028 mod1030 (lambda (vars1035 docstring1036 body1037)
(build-annotated78 s1029 (cons (quote lambda) (cons vars1035 (append (if
docstring1036 (list docstring1036) (quote ())) (list body1037)))))))) tmp1032)
(syntax-violation #f "source expression failed to match any pattern" tmp1031)))
($sc-dispatch tmp1031 (quote (any . any))))) e1026))) (global-extend99 (quote
core) (quote let) (letrec ((chi-let1038 (lambda (e1039 r1040 w1041 s1042
mod1043 constructor1044 ids1045 vals1046 exps1047) (if (not
(valid-bound-ids?126 ids1045)) (syntax-violation (quote let) "duplicate bound
variable" e1039) (let ((labels1048 (gen-labels107 ids1045)) (new-vars1049 (map
gen-var149 ids1045))) (let ((nw1050 (make-binding-wrap118 ids1045 labels1048
w1041)) (nr1051 (extend-var-env96 labels1048 new-vars1049 r1040)))
(constructor1044 s1042 new-vars1049 (map (lambda (x1052) (chi137 x1052 r1040
w1041 mod1043)) vals1046) (chi-body141 exps1047 (source-wrap130 e1039 nw1050
s1042 mod1043) nr1051 nw1050 mod1043)))))))) (lambda (e1053 r1054 w1055 s1056
mod1057) ((lambda (tmp1058) ((lambda (tmp1059) (if tmp1059 (apply (lambda
(_1060 id1061 val1062 e11063 e21064) (chi-let1038 e1053 r1054 w1055 s1056
mod1057 build-let81 id1061 val1062 (cons e11063 e21064))) tmp1059) ((lambda
(tmp1068) (if (if tmp1068 (apply (lambda (_1069 f1070 id1071 val1072 e11073
e21074) (id?101 f1070)) tmp1068) #f) (apply (lambda (_1075 f1076 id1077 val1078
e11079 e21080) (chi-let1038 e1053 r1054 w1055 s1056 mod1057 build-named-let82
(cons f1076 id1077) val1078 (cons e11079 e21080))) tmp1068) ((lambda (_1084)
(syntax-violation (quote let) "bad let" (source-wrap130 e1053 w1055 s1056
mod1057))) tmp1058))) ($sc-dispatch tmp1058 (quote (any any #(each (any any))
any . each-any)))))) ($sc-dispatch tmp1058 (quote (any #(each (any any)) any .
each-any))))) e1053)))) (global-extend99 (quote core) (quote letrec) (lambda
(e1085 r1086 w1087 s1088 mod1089) ((lambda (tmp1090) ((lambda (tmp1091) (if
tmp1091 (apply (lambda (_1092 id1093 val1094 e11095 e21096) (let ((ids1097
id1093)) (if (not (valid-bound-ids?126 ids1097)) (syntax-violation (quote
letrec) "duplicate bound variable" e1085) (let ((labels1099 (gen-labels107
ids1097)) (new-vars1100 (map gen-var149 ids1097))) (let ((w1101
(make-binding-wrap118 ids1097 labels1099 w1087)) (r1102 (extend-var-env96
labels1099 new-vars1100 r1086))) (build-letrec83 s1088 new-vars1100 (map
(lambda (x1103) (chi137 x1103 r1102 w1101 mod1089)) val1094) (chi-body141 (cons
e11095 e21096) (source-wrap130 e1085 w1101 s1088 mod1089) r1102 w1101
mod1089))))))) tmp1091) ((lambda (_1106) (syntax-violation (quote letrec) "bad
letrec" (source-wrap130 e1085 w1087 s1088 mod1089))) tmp1090))) ($sc-dispatch
tmp1090 (quote (any #(each (any any)) any . each-any))))) e1085)))
(global-extend99 (quote core) (quote set!) (lambda (e1107 r1108 w1109 s1110
mod1111) ((lambda (tmp1112) ((lambda (tmp1113) (if (if tmp1113 (apply (lambda
(_1114 id1115 val1116) (id?101 id1115)) tmp1113) #f) (apply (lambda (_1117
id1118 val1119) (let ((val1120 (chi137 val1119 r1108 w1109 mod1111)) (n1121
(id-var-name123 id1118 w1109))) (let ((b1122 (lookup98 n1121 r1108 mod1111)))
(let ((t1123 (binding-type93 b1122))) (if (memv t1123 (quote (lexical)))
(build-annotated78 s1110 (list (quote set!) (binding-value94 b1122) val1120))
(if (memv t1123 (quote (global))) (build-annotated78 s1110 (list (quote set!)
(if mod1111 (make-module-ref (cdr mod1111) n1121 (car mod1111))
(make-module-ref mod1111 n1121 (quote bare))) val1120)) (if (memv t1123 (quote
(displaced-lexical))) (syntax-violation (quote set!) "identifier out of
context" (wrap129 id1118 w1109 mod1111)) (syntax-violation (quote set!) "bad
set!" (source-wrap130 e1107 w1109 s1110 mod1111))))))))) tmp1113) ((lambda
(tmp1124) (if tmp1124 (apply (lambda (_1125 head1126 tail1127 val1128)
(call-with-values (lambda () (syntax-type135 head1126 r1108 (quote (())) #f #f
mod1111)) (lambda (type1129 value1130 ee1131 ww1132 ss1133 modmod1134) (let
((t1135 type1129)) (if (memv t1135 (quote (module-ref))) (let ((val1136 (chi137
val1128 r1108 w1109 mod1111))) (call-with-values (lambda () (value1130 (cons
head1126 tail1127))) (lambda (id1138 mod1139) (build-annotated78 s1110 (list
(quote set!) (if mod1139 (make-module-ref (cdr mod1139) id1138 (car mod1139))
(make-module-ref mod1139 id1138 (quote bare))) val1136))))) (build-annotated78
s1110 (cons (chi137 (list (quote #(syntax-object setter ((top) #(ribcage () ()
()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((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-module! set-syntax-object-wrap!
set-syntax-object-expression! syntax-object-module syntax-object-wrap
syntax-object-expression syntax-object? make-syntax-object 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 build-annotated get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top))
("i" "i"))) (hygiene guile))) head1126) r1108 w1109 mod1111) (map (lambda
(e1140) (chi137 e1140 r1108 w1109 mod1111)) (append tail1127 (list
val1128)))))))))) tmp1124) ((lambda (_1142) (syntax-violation (quote set!) "bad
set!" (source-wrap130 e1107 w1109 s1110 mod1111))) tmp1112))) ($sc-dispatch
tmp1112 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1112 (quote
(any any any))))) e1107))) (global-extend99 (quote module-ref) (quote @)
(lambda (e1143) ((lambda (tmp1144) ((lambda (tmp1145) (if (if tmp1145 (apply
(lambda (_1146 mod1147 id1148) (and (and-map id?101 mod1147) (id?101 id1148)))
tmp1145) #f) (apply (lambda (_1150 mod1151 id1152) (values (syntax->datum
id1152) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_
mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e)
#((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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
mod1151)))) tmp1145) (syntax-violation #f "source expression failed to match
any pattern" tmp1144))) ($sc-dispatch tmp1144 (quote (any each-any any)))))
e1143))) (global-extend99 (quote module-ref) (quote @@) (lambda (e1154)
((lambda (tmp1155) ((lambda (tmp1156) (if (if tmp1156 (apply (lambda (_1157
mod1158 id1159) (and (and-map id?101 mod1158) (id?101 id1159))) tmp1156) #f)
(apply (lambda (_1161 mod1162 id1163) (values (syntax->datum id1163)
(syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod
id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e)
#((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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
mod1162)))) tmp1156) (syntax-violation #f "source expression failed to match
any pattern" tmp1155))) ($sc-dispatch tmp1155 (quote (any each-any any)))))
e1154))) (global-extend99 (quote begin) (quote begin) (quote ()))
(global-extend99 (quote define) (quote define) (quote ())) (global-extend99
(quote define-syntax) (quote define-syntax) (quote ())) (global-extend99 (quote
eval-when) (quote eval-when) (quote ())) (global-extend99 (quote core) (quote
syntax-case) (letrec ((gen-syntax-case1168 (lambda (x1169 keys1170 clauses1171
r1172 mod1173) (if (null? clauses1171) (build-annotated78 #f (list
(build-annotated78 #f (quote syntax-violation)) #f "source expression failed to
match any pattern" x1169)) ((lambda (tmp1174) ((lambda (tmp1175) (if tmp1175
(apply (lambda (pat1176 exp1177) (if (and (id?101 pat1176) (and-map (lambda
(x1178) (not (free-id=?124 pat1176 x1178))) (cons (quote #(syntax-object ...
((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "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-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
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 build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook 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 and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
keys1170))) (let ((labels1179 (list (gen-label106))) (var1180 (gen-var149
pat1176))) (build-annotated78 #f (list (build-annotated78 #f (list (quote
lambda) (list var1180) (chi137 exp1177 (extend-env95 labels1179 (list (cons
(quote syntax) (cons var1180 0))) r1172) (make-binding-wrap118 (list pat1176)
labels1179 (quote (()))) mod1173))) x1169))) (gen-clause1167 x1169 keys1170
(cdr clauses1171) r1172 pat1176 #t exp1177 mod1173))) tmp1175) ((lambda
(tmp1181) (if tmp1181 (apply (lambda (pat1182 fender1183 exp1184)
(gen-clause1167 x1169 keys1170 (cdr clauses1171) r1172 pat1182 fender1183
exp1184 mod1173)) tmp1181) ((lambda (_1185) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses1171))) tmp1174))) ($sc-dispatch
tmp1174 (quote (any any any)))))) ($sc-dispatch tmp1174 (quote (any any)))))
(car clauses1171))))) (gen-clause1167 (lambda (x1186 keys1187 clauses1188 r1189
pat1190 fender1191 exp1192 mod1193) (call-with-values (lambda ()
(convert-pattern1165 pat1190 keys1187)) (lambda (p1194 pvars1195) (cond ((not
(distinct-bound-ids?127 (map car pvars1195))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat1190)) ((not (and-map (lambda
(x1196) (not (ellipsis?146 (car x1196)))) pvars1195)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat1190)) (else (let ((y1197 (gen-var149
(quote tmp)))) (build-annotated78 #f (list (build-annotated78 #f (list (quote
lambda) (list y1197) (let ((y1198 (build-annotated78 #f y1197)))
(build-annotated78 #f (list (quote if) ((lambda (tmp1199) ((lambda (tmp1200)
(if tmp1200 (apply (lambda () y1198) tmp1200) ((lambda (_1201)
(build-annotated78 #f (list (quote if) y1198 (build-dispatch-call1166 pvars1195
fender1191 y1198 r1189 mod1193) (build-data79 #f #f)))) tmp1199)))
($sc-dispatch tmp1199 (quote #(atom #t))))) fender1191)
(build-dispatch-call1166 pvars1195 exp1192 y1198 r1189 mod1193)
(gen-syntax-case1168 x1186 keys1187 clauses1188 r1189 mod1193)))))) (if (eq?
p1194 (quote any)) (build-annotated78 #f (list (build-annotated78 #f (quote
list)) x1186)) (build-annotated78 #f (list (build-annotated78 #f (quote
$sc-dispatch)) x1186 (build-data79 #f p1194)))))))))))))
(build-dispatch-call1166 (lambda (pvars1202 exp1203 y1204 r1205 mod1206) (let
((ids1207 (map car pvars1202)) (levels1208 (map cdr pvars1202))) (let
((labels1209 (gen-labels107 ids1207)) (new-vars1210 (map gen-var149 ids1207)))
(build-annotated78 #f (list (build-annotated78 #f (quote apply))
(build-annotated78 #f (list (quote lambda) new-vars1210 (chi137 exp1203
(extend-env95 labels1209 (map (lambda (var1211 level1212) (cons (quote syntax)
(cons var1211 level1212))) new-vars1210 (map cdr pvars1202)) r1205)
(make-binding-wrap118 ids1207 labels1209 (quote (()))) mod1206))) y1204))))))
(convert-pattern1165 (lambda (pattern1213 keys1214) (let cvt1215 ((p1216
pattern1213) (n1217 0) (ids1218 (quote ()))) (if (id?101 p1216) (if
(bound-id-member?128 p1216 keys1214) (values (vector (quote free-id) p1216)
ids1218) (values (quote any) (cons (cons p1216 n1217) ids1218))) ((lambda
(tmp1219) ((lambda (tmp1220) (if (if tmp1220 (apply (lambda (x1221 dots1222)
(ellipsis?146 dots1222)) tmp1220) #f) (apply (lambda (x1223 dots1224)
(call-with-values (lambda () (cvt1215 x1223 (fx+70 n1217 1) ids1218)) (lambda
(p1225 ids1226) (values (if (eq? p1225 (quote any)) (quote each-any) (vector
(quote each) p1225)) ids1226)))) tmp1220) ((lambda (tmp1227) (if tmp1227 (apply
(lambda (x1228 y1229) (call-with-values (lambda () (cvt1215 y1229 n1217
ids1218)) (lambda (y1230 ids1231) (call-with-values (lambda () (cvt1215 x1228
n1217 ids1231)) (lambda (x1232 ids1233) (values (cons x1232 y1230)
ids1233)))))) tmp1227) ((lambda (tmp1234) (if tmp1234 (apply (lambda () (values
(quote ()) ids1218)) tmp1234) ((lambda (tmp1235) (if tmp1235 (apply (lambda
(x1236) (call-with-values (lambda () (cvt1215 x1236 n1217 ids1218)) (lambda
(p1238 ids1239) (values (vector (quote vector) p1238) ids1239)))) tmp1235)
((lambda (x1240) (values (vector (quote atom) (strip148 p1216 (quote (()))))
ids1218)) tmp1219))) ($sc-dispatch tmp1219 (quote #(vector each-any))))))
($sc-dispatch tmp1219 (quote ()))))) ($sc-dispatch tmp1219 (quote (any .
any)))))) ($sc-dispatch tmp1219 (quote (any any))))) p1216)))))) (lambda (e1241
r1242 w1243 s1244 mod1245) (let ((e1246 (source-wrap130 e1241 w1243 s1244
mod1245))) ((lambda (tmp1247) ((lambda (tmp1248) (if tmp1248 (apply (lambda
(_1249 val1250 key1251 m1252) (if (and-map (lambda (x1253) (and (id?101 x1253)
(not (ellipsis?146 x1253)))) key1251) (let ((x1255 (gen-var149 (quote tmp))))
(build-annotated78 s1244 (list (build-annotated78 #f (list (quote lambda) (list
x1255) (gen-syntax-case1168 (build-annotated78 #f x1255) key1251 m1252 r1242
mod1245))) (chi137 val1250 r1242 (quote (())) mod1245)))) (syntax-violation
(quote syntax-case) "invalid literals list" e1246))) tmp1248) (syntax-violation
#f "source expression failed to match any pattern" tmp1247))) ($sc-dispatch
tmp1247 (quote (any any each-any . each-any))))) e1246))))) (set! sc-expand
(let ((m1258 (quote e)) (esew1259 (quote (eval)))) (lambda (x1260) (if (and
(pair? x1260) (equal? (car x1260) noexpand69)) (cadr x1260) (chi-top136 x1260
(quote ()) (quote ((top))) m1258 esew1259 (cons (quote hygiene) (module-name
(current-module)))))))) (set! sc-expand3 (let ((m1261 (quote e)) (esew1262
(quote (eval)))) (lambda (x1264 . rest1263) (if (and (pair? x1264) (equal? (car
x1264) noexpand69)) (cadr x1264) (chi-top136 x1264 (quote ()) (quote ((top)))
(if (null? rest1263) m1261 (car rest1263)) (if (or (null? rest1263) (null? (cdr
rest1263))) esew1262 (cadr rest1263)) (cons (quote hygiene) (module-name
(current-module)))))))) (set! identifier? (lambda (x1265) (nonsymbol-id?100
x1265))) (set! datum->syntax (lambda (id1266 datum1267) (make-syntax-object84
datum1267 (syntax-object-wrap87 id1266) #f))) (set! syntax->datum (lambda
(x1268) (strip148 x1268 (quote (()))))) (set! generate-temporaries (lambda
(ls1269) (begin (let ((x1270 ls1269)) (if (not (list? x1270)) (syntax-violation
(quote generate-temporaries) "invalid argument" x1270))) (map (lambda (x1271)
(wrap129 (gensym) (quote ((top))) #f)) ls1269)))) (set! free-identifier=?
(lambda (x1272 y1273) (begin (let ((x1274 x1272)) (if (not (nonsymbol-id?100
x1274)) (syntax-violation (quote free-identifier=?) "invalid argument" x1274)))
(let ((x1275 y1273)) (if (not (nonsymbol-id?100 x1275)) (syntax-violation
(quote free-identifier=?) "invalid argument" x1275))) (free-id=?124 x1272
y1273)))) (set! bound-identifier=? (lambda (x1276 y1277) (begin (let ((x1278
x1276)) (if (not (nonsymbol-id?100 x1278)) (syntax-violation (quote
bound-identifier=?) "invalid argument" x1278))) (let ((x1279 y1277)) (if (not
(nonsymbol-id?100 x1279)) (syntax-violation (quote bound-identifier=?) "invalid
argument" x1279))) (bound-id=?125 x1276 y1277)))) (set! syntax-violation
(lambda (who1283 message1282 form1281 . subform1280) (begin (let ((x1284
who1283)) (if (not ((lambda (x1285) (or (not x1285) (string? x1285) (symbol?
x1285))) x1284)) (syntax-violation (quote syntax-violation) "invalid argument"
x1284))) (let ((x1286 message1282)) (if (not (string? x1286)) (syntax-violation
(quote syntax-violation) "invalid argument" x1286))) (scm-error (quote
syntax-error) (quote sc-expand) (string-append (if who1283 "~a: " "") "~a " (if
(null? subform1280) "in ~a" "in subform `~s' of `~s'")) (let ((tail1287 (cons
message1282 (map (lambda (x1288) (strip148 x1288 (quote (())))) (append
subform1280 (list form1281)))))) (if who1283 (cons who1283 tail1287) tail1287))
#f)))) (letrec ((match1293 (lambda (e1294 p1295 w1296 r1297 mod1298) (cond
((not r1297) #f) ((eq? p1295 (quote any)) (cons (wrap129 e1294 w1296 mod1298)
r1297)) ((syntax-object?85 e1294) (match*1292 (let ((e1299
(syntax-object-expression86 e1294))) (if (annotation? e1299)
(annotation-expression e1299) e1299)) p1295 (join-wraps120 w1296
(syntax-object-wrap87 e1294)) r1297 (syntax-object-module88 e1294))) (else
(match*1292 (let ((e1300 e1294)) (if (annotation? e1300) (annotation-expression
e1300) e1300)) p1295 w1296 r1297 mod1298))))) (match*1292 (lambda (e1301 p1302
w1303 r1304 mod1305) (cond ((null? p1302) (and (null? e1301) r1304)) ((pair?
p1302) (and (pair? e1301) (match1293 (car e1301) (car p1302) w1303 (match1293
(cdr e1301) (cdr p1302) w1303 r1304 mod1305) mod1305))) ((eq? p1302 (quote
each-any)) (let ((l1306 (match-each-any1290 e1301 w1303 mod1305))) (and l1306
(cons l1306 r1304)))) (else (let ((t1307 (vector-ref p1302 0))) (if (memv t1307
(quote (each))) (if (null? e1301) (match-empty1291 (vector-ref p1302 1) r1304)
(let ((l1308 (match-each1289 e1301 (vector-ref p1302 1) w1303 mod1305))) (and
l1308 (let collect1309 ((l1310 l1308)) (if (null? (car l1310)) r1304 (cons (map
car l1310) (collect1309 (map cdr l1310)))))))) (if (memv t1307 (quote
(free-id))) (and (id?101 e1301) (free-id=?124 (wrap129 e1301 w1303 mod1305)
(vector-ref p1302 1)) r1304) (if (memv t1307 (quote (atom))) (and (equal?
(vector-ref p1302 1) (strip148 e1301 w1303)) r1304) (if (memv t1307 (quote
(vector))) (and (vector? e1301) (match1293 (vector->list e1301) (vector-ref
p1302 1) w1303 r1304 mod1305))))))))))) (match-empty1291 (lambda (p1311 r1312)
(cond ((null? p1311) r1312) ((eq? p1311 (quote any)) (cons (quote ()) r1312))
((pair? p1311) (match-empty1291 (car p1311) (match-empty1291 (cdr p1311)
r1312))) ((eq? p1311 (quote each-any)) (cons (quote ()) r1312)) (else (let
((t1313 (vector-ref p1311 0))) (if (memv t1313 (quote (each))) (match-empty1291
(vector-ref p1311 1) r1312) (if (memv t1313 (quote (free-id atom))) r1312 (if
(memv t1313 (quote (vector))) (match-empty1291 (vector-ref p1311 1)
r1312))))))))) (match-each-any1290 (lambda (e1314 w1315 mod1316) (cond
((annotation? e1314) (match-each-any1290 (annotation-expression e1314) w1315
mod1316)) ((pair? e1314) (let ((l1317 (match-each-any1290 (cdr e1314) w1315
mod1316))) (and l1317 (cons (wrap129 (car e1314) w1315 mod1316) l1317))))
((null? e1314) (quote ())) ((syntax-object?85 e1314) (match-each-any1290
(syntax-object-expression86 e1314) (join-wraps120 w1315 (syntax-object-wrap87
e1314)) mod1316)) (else #f)))) (match-each1289 (lambda (e1318 p1319 w1320
mod1321) (cond ((annotation? e1318) (match-each1289 (annotation-expression
e1318) p1319 w1320 mod1321)) ((pair? e1318) (let ((first1322 (match1293 (car
e1318) p1319 w1320 (quote ()) mod1321))) (and first1322 (let ((rest1323
(match-each1289 (cdr e1318) p1319 w1320 mod1321))) (and rest1323 (cons
first1322 rest1323)))))) ((null? e1318) (quote ())) ((syntax-object?85 e1318)
(match-each1289 (syntax-object-expression86 e1318) p1319 (join-wraps120 w1320
(syntax-object-wrap87 e1318)) (syntax-object-module88 e1318))) (else #f)))))
(set! $sc-dispatch (lambda (e1324 p1325) (cond ((eq? p1325 (quote any)) (list
e1324)) ((syntax-object?85 e1324) (match*1292 (let ((e1326
(syntax-object-expression86 e1324))) (if (annotation? e1326)
(annotation-expression e1326) e1326)) p1325 (syntax-object-wrap87 e1324) (quote
()) (syntax-object-module88 e1324))) (else (match*1292 (let ((e1327 e1324)) (if
(annotation? e1327) (annotation-expression e1327) e1327)) p1325 (quote (()))
(quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1328) ((lambda
(tmp1329) ((lambda (tmp1330) (if tmp1330 (apply (lambda (_1331 e11332 e21333)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11332 e21333))) tmp1330) ((lambda (tmp1335) (if
tmp1335 (apply (lambda (_1336 out1337 in1338 e11339 e21340) (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"))) (hygiene guile))) in1338 (quote ()) (list out1337 (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"))) (hygiene guile))) (cons e11339 e21340))))) tmp1335) ((lambda
(tmp1342) (if tmp1342 (apply (lambda (_1343 out1344 in1345 e11346 e21347) (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"))) (hygiene guile))) (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"))) (hygiene
guile))) in1345) (quote ()) (list out1344 (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"))) (hygiene
guile))) (cons e11346 e21347))))) tmp1342) (syntax-violation #f "source
expression failed to match any pattern" tmp1329))) ($sc-dispatch tmp1329 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1329 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1329 (quote (any () any .
each-any))))) x1328))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1351)
((lambda (tmp1352) ((lambda (tmp1353) (if tmp1353 (apply (lambda (_1354 k1355
keyword1356 pattern1357 template1358) (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"))) (hygiene guile))) (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"))) (hygiene guile))))
(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"))) (hygiene guile))) (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"))) (hygiene guile))) (cons k1355 (map (lambda (tmp1361
tmp1360) (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"))) (hygiene guile)))
tmp1360) (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"))) (hygiene guile)))
tmp1361))) template1358 pattern1357)))))) tmp1353) (syntax-violation #f "source
expression failed to match any pattern" tmp1352))) ($sc-dispatch tmp1352 (quote
(any each-any . #(each ((any . any) any))))))) x1351))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1362) ((lambda (tmp1363) ((lambda (tmp1364) (if
(if tmp1364 (apply (lambda (let*1365 x1366 v1367 e11368 e21369) (and-map
identifier? x1366)) tmp1364) #f) (apply (lambda (let*1371 x1372 v1373 e11374
e21375) (let f1376 ((bindings1377 (map list x1372 v1373))) (if (null?
bindings1377) (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"))) (hygiene guile))) (cons (quote ()) (cons
e11374 e21375))) ((lambda (tmp1381) ((lambda (tmp1382) (if tmp1382 (apply
(lambda (body1383 binding1384) (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"))) (hygiene guile))) (list binding1384)
body1383)) tmp1382) (syntax-violation #f "source expression failed to match any
pattern" tmp1381))) ($sc-dispatch tmp1381 (quote (any any))))) (list (f1376
(cdr bindings1377)) (car bindings1377)))))) tmp1364) (syntax-violation #f
"source expression failed to match any pattern" tmp1363))) ($sc-dispatch
tmp1363 (quote (any #(each (any any)) any . each-any))))) x1362))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1385) ((lambda (tmp1386) ((lambda (tmp1387)
(if tmp1387 (apply (lambda (_1388 var1389 init1390 step1391 e01392 e11393
c1394) ((lambda (tmp1395) ((lambda (tmp1396) (if tmp1396 (apply (lambda
(step1397) ((lambda (tmp1398) ((lambda (tmp1399) (if tmp1399 (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"))) (hygiene guile))) (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"))) (hygiene guile))) (map list
var1389 init1390) (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"))) (hygiene guile))) (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")))
(hygiene guile))) e01392) (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"))) (hygiene guile))) (append c1394 (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"))) (hygiene guile))) step1397))))))) tmp1399) ((lambda (tmp1404)
(if tmp1404 (apply (lambda (e11405 e21406) (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"))) (hygiene guile))) (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"))) (hygiene guile))) (map list var1389 init1390) (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"))) (hygiene guile))) e01392 (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"))) (hygiene guile)))
(cons e11405 e21406)) (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")))
(hygiene guile))) (append c1394 (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"))) (hygiene guile))) step1397))))))) tmp1404)
(syntax-violation #f "source expression failed to match any pattern" tmp1398)))
($sc-dispatch tmp1398 (quote (any . each-any)))))) ($sc-dispatch tmp1398 (quote
())))) e11393)) tmp1396) (syntax-violation #f "source expression failed to
match any pattern" tmp1395))) ($sc-dispatch tmp1395 (quote each-any)))) (map
(lambda (v1413 s1414) ((lambda (tmp1415) ((lambda (tmp1416) (if tmp1416 (apply
(lambda () v1413) tmp1416) ((lambda (tmp1417) (if tmp1417 (apply (lambda
(e1418) e1418) tmp1417) ((lambda (_1419) (syntax-violation (quote do) "bad step
expression" orig-x1385 s1414)) tmp1415))) ($sc-dispatch tmp1415 (quote
(any)))))) ($sc-dispatch tmp1415 (quote ())))) s1414)) var1389 step1391)))
tmp1387) (syntax-violation #f "source expression failed to match any pattern"
tmp1386))) ($sc-dispatch tmp1386 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1385))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1422 (lambda (x1426 y1427)
((lambda (tmp1428) ((lambda (tmp1429) (if tmp1429 (apply (lambda (x1430 y1431)
((lambda (tmp1432) ((lambda (tmp1433) (if tmp1433 (apply (lambda (dy1434)
((lambda (tmp1435) ((lambda (tmp1436) (if tmp1436 (apply (lambda (dx1437) (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"))) (hygiene guile))) (cons dx1437 dy1434))) tmp1436) ((lambda
(_1438) (if (null? dy1434) (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"))) (hygiene guile))) x1430) (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"))) (hygiene guile))) x1430 y1431))) tmp1435))) ($sc-dispatch
tmp1435 (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"))) (hygiene guile))) any))))) x1430)) tmp1433) ((lambda (tmp1439) (if
tmp1439 (apply (lambda (stuff1440) (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"))) (hygiene guile))) (cons x1430 stuff1440))) tmp1439)
((lambda (else1441) (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"))) (hygiene guile))) x1430 y1431)) tmp1432))) ($sc-dispatch tmp1432
(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"))) (hygiene guile))) . any))))))
($sc-dispatch tmp1432 (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"))) (hygiene
guile))) any))))) y1431)) tmp1429) (syntax-violation #f "source expression
failed to match any pattern" tmp1428))) ($sc-dispatch tmp1428 (quote (any
any))))) (list x1426 y1427)))) (quasiappend1423 (lambda (x1442 y1443) ((lambda
(tmp1444) ((lambda (tmp1445) (if tmp1445 (apply (lambda (x1446 y1447) ((lambda
(tmp1448) ((lambda (tmp1449) (if tmp1449 (apply (lambda () x1446) tmp1449)
((lambda (_1450) (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"))) (hygiene guile))) x1446 y1447)) tmp1448))) ($sc-dispatch tmp1448
(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"))) (hygiene guile))) ()))))) y1447))
tmp1445) (syntax-violation #f "source expression failed to match any pattern"
tmp1444))) ($sc-dispatch tmp1444 (quote (any any))))) (list x1442 y1443))))
(quasivector1424 (lambda (x1451) ((lambda (tmp1452) ((lambda (x1453) ((lambda
(tmp1454) ((lambda (tmp1455) (if tmp1455 (apply (lambda (x1456) (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"))) (hygiene guile))) (list->vector
x1456))) tmp1455) ((lambda (tmp1458) (if tmp1458 (apply (lambda (x1459) (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"))) (hygiene guile))) x1459)) tmp1458)
((lambda (_1461) (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")))
(hygiene guile))) x1453)) tmp1454))) ($sc-dispatch tmp1454 (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")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp1454 (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")))
(hygiene guile))) each-any))))) x1453)) tmp1452)) x1451))) (quasi1425 (lambda
(p1462 lev1463) ((lambda (tmp1464) ((lambda (tmp1465) (if tmp1465 (apply
(lambda (p1466) (if (= lev1463 0) p1466 (quasicons1422 (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"))) (hygiene guile))
#(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")))
(hygiene guile)))) (quasi1425 (list p1466) (- lev1463 1))))) tmp1465) ((lambda
(tmp1467) (if tmp1467 (apply (lambda (p1468 q1469) (if (= lev1463 0)
(quasiappend1423 p1468 (quasi1425 q1469 lev1463)) (quasicons1422 (quasicons1422
(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"))) (hygiene guile)) #(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"))) (hygiene guile))))
(quasi1425 (list p1468) (- lev1463 1))) (quasi1425 q1469 lev1463)))) tmp1467)
((lambda (tmp1470) (if tmp1470 (apply (lambda (p1471) (quasicons1422 (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")))
(hygiene guile)) #(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"))) (hygiene guile)))) (quasi1425 (list p1471) (+ lev1463
1)))) tmp1470) ((lambda (tmp1472) (if tmp1472 (apply (lambda (p1473 q1474)
(quasicons1422 (quasi1425 p1473 lev1463) (quasi1425 q1474 lev1463))) tmp1472)
((lambda (tmp1475) (if tmp1475 (apply (lambda (x1476) (quasivector1424
(quasi1425 x1476 lev1463))) tmp1475) ((lambda (p1478) (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")))
(hygiene guile))) p1478)) tmp1464))) ($sc-dispatch tmp1464 (quote #(vector
each-any)))))) ($sc-dispatch tmp1464 (quote (any . any)))))) ($sc-dispatch
tmp1464 (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"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp1464 (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"))) (hygiene guile))) any) . any))))))
($sc-dispatch tmp1464 (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"))) (hygiene guile))) any))))) p1462)))) (lambda (x1479) ((lambda
(tmp1480) ((lambda (tmp1481) (if tmp1481 (apply (lambda (_1482 e1483)
(quasi1425 e1483 0)) tmp1481) (syntax-violation #f "source expression failed to
match any pattern" tmp1480))) ($sc-dispatch tmp1480 (quote (any any)))))
x1479)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1484) (letrec
((read-file1485 (lambda (fn1486 k1487) (let ((p1488 (open-input-file fn1486)))
(let f1489 ((x1490 (read p1488))) (if (eof-object? x1490) (begin
(close-input-port p1488) (quote ())) (cons (datum->syntax k1487 x1490) (f1489
(read p1488))))))))) ((lambda (tmp1491) ((lambda (tmp1492) (if tmp1492 (apply
(lambda (k1493 filename1494) (let ((fn1495 (syntax->datum filename1494)))
((lambda (tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (exp1498)
(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"))) (hygiene guile))) exp1498))
tmp1497) (syntax-violation #f "source expression failed to match any pattern"
tmp1496))) ($sc-dispatch tmp1496 (quote each-any)))) (read-file1485 fn1495
k1493)))) tmp1492) (syntax-violation #f "source expression failed to match any
pattern" tmp1491))) ($sc-dispatch tmp1491 (quote (any any))))) x1484)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1500) ((lambda
(tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (_1503 e1504)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1500)) tmp1502) (syntax-violation #f "source expression failed to match any
pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any any))))) x1500))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1505)
((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (_1508 e1509)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1505)) tmp1507) (syntax-violation #f "source expression failed to
match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any)))))
x1505))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1510) ((lambda (tmp1511) ((lambda (tmp1512) (if
tmp1512 (apply (lambda (_1513 e1514 m11515 m21516) ((lambda (tmp1517) ((lambda
(body1518) (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"))) (hygiene guile))) (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"))) (hygiene guile))) e1514)) body1518))
tmp1517)) (let f1519 ((clause1520 m11515) (clauses1521 m21516)) (if (null?
clauses1521) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda
(e11525 e21526) (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")))
(hygiene guile))) (cons e11525 e21526))) tmp1524) ((lambda (tmp1528) (if
tmp1528 (apply (lambda (k1529 e11530 e21531) (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"))) (hygiene guile))) (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"))) (hygiene guile)))
(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"))) (hygiene
guile))) (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")))
(hygiene guile))) k1529)) (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"))) (hygiene guile))) (cons e11530 e21531)))) tmp1528)
((lambda (_1534) (syntax-violation (quote case) "bad clause" x1510 clause1520))
tmp1523))) ($sc-dispatch tmp1523 (quote (each-any any . each-any))))))
($sc-dispatch tmp1523 (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"))) (hygiene guile))) any .
each-any))))) clause1520) ((lambda (tmp1535) ((lambda (rest1536) ((lambda
(tmp1537) ((lambda (tmp1538) (if tmp1538 (apply (lambda (k1539 e11540 e21541)
(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"))) (hygiene guile))) (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")))
(hygiene guile))) (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"))) (hygiene guile))) (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"))) (hygiene guile))) k1539)) (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"))) (hygiene guile))) (cons e11540 e21541)) rest1536)) tmp1538)
((lambda (_1544) (syntax-violation (quote case) "bad clause" x1510 clause1520))
tmp1537))) ($sc-dispatch tmp1537 (quote (each-any any . each-any)))))
clause1520)) tmp1535)) (f1519 (car clauses1521) (cdr clauses1521)))))))
tmp1512) (syntax-violation #f "source expression failed to match any pattern"
tmp1511))) ($sc-dispatch tmp1511 (quote (any any any . each-any))))) x1510))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1545)
((lambda (tmp1546) ((lambda (tmp1547) (if tmp1547 (apply (lambda (_1548 e1549)
(list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list
(quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
e1549)) (list (cons _1548 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e1549 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)))))))))) tmp1547) (syntax-violation #f "source expression failed to
match any pattern" tmp1546))) ($sc-dispatch tmp1546 (quote (any any)))))
x1545))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 2cf83f7..fa289f3 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -81,8 +81,6 @@
;;; Revision 3, for a complete description)
;;; (syntax-violation who message form [subform])
;;; used to report errors found during expansion
-;;; (install-global-transformer symbol value)
-;;; used by expanded code to install top-level syntactic abstractions
;;; ($sc-dispatch e p)
;;; used by expanded code to handle syntax-case matching
@@ -93,29 +91,6 @@
;;; returns the implementation's cannonical "unspecified value". This
;;; usually works: (define void (lambda () (if #f #f))).
;;;
-;;; (andmap proc list1 list2 ...)
-;;; returns true if proc returns true when applied to each element of list1
-;;; along with the corresponding elements of list2 ....
-;;; The following definition works but does no error checking:
-;;;
-;;; (define andmap
-;;; (lambda (f first . rest)
-;;; (or (null? first)
-;;; (if (null? rest)
-;;; (let andmap ((first first))
-;;; (let ((x (car first)) (first (cdr first)))
-;;; (if (null? first)
-;;; (f x)
-;;; (and (f x) (andmap first)))))
-;;; (let andmap ((first first) (rest rest))
-;;; (let ((x (car first))
-;;; (xr (map car rest))
-;;; (first (cdr first))
-;;; (rest (map cdr rest)))
-;;; (if (null? first)
-;;; (apply f (cons x xr))
-;;; (and (apply f (cons x xr)) (andmap first rest)))))))))
-;;;
;;; The following nonstandard procedures must also be provided by the
;;; implementation for this code to run using the standard portable
;;; hooks and output constructors. They are not used by expanded code,
@@ -134,13 +109,6 @@
;;; by eval, and eval accepts one argument, nothing special must be done
;;; to support the "noexpand" flag, since it is handled by sc-expand.
;;;
-;;; (error who format-string why what)
-;;; where who is either a symbol or #f, format-string is always "~a ~s",
-;;; why is always a string, and what may be any object. error should
-;;; signal an error with a message something like
-;;;
-;;; "error in <who>: <why> <what>"
-;;;
;;; (gensym)
;;; returns a unique symbol each time it's called
;;;
@@ -260,6 +228,25 @@
(set-current-module (resolve-module '(guile))))
(let ()
+;;; Private version of and-map that handles multiple lists.
+(define and-map*
+ (lambda (f first . rest)
+ (or (null? first)
+ (if (null? rest)
+ (let andmap ((first first))
+ (let ((x (car first)) (first (cdr first)))
+ (if (null? first)
+ (f x)
+ (and (f x) (andmap first)))))
+ (let andmap ((first first) (rest rest))
+ (let ((x (car first))
+ (xr (map car rest))
+ (first (cdr first))
+ (rest (map cdr rest)))
+ (if (null? first)
+ (apply f (cons x xr))
+ (and (apply f (cons x xr)) (andmap first rest)))))))))
+
(define-syntax define-structure
(lambda (x)
(define construct-name
@@ -275,7 +262,9 @@
args))))))
(syntax-case x ()
((_ (name id1 ...))
- (andmap identifier? (syntax (name id1 ...)))
+ ;; But here we use and-map, because andmap isn't yet in scope for
+ ;; syntax.
+ (and-map identifier? (syntax (name id1 ...)))
(with-syntax
((constructor (construct-name (syntax name) "make-" (syntax name)))
(predicate (construct-name (syntax name) (syntax name) "?"))
@@ -329,10 +318,6 @@
(lambda (x mod)
(primitive-eval `(,noexpand ,x))))
-(define error-hook
- (lambda (who why what)
- (error who "~a ~s" why what)))
-
(define-syntax gensym-hook
(syntax-rules ()
((_) (gensym))))
@@ -492,7 +477,7 @@
(syntax-rules ()
((_ pred? e who)
(let ((x e))
- (if (not (pred? x)) (error-hook who "invalid argument" x))))))
+ (if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
;;; compile-time environments
@@ -812,7 +797,7 @@
((annotation? id)
(let ((id (unannotate id)))
(or (first (search id (wrap-subst w) (wrap-marks w))) id)))
- (else (error-hook 'id-var-name "invalid id" id)))))
+ (else (syntax-violation 'id-var-name "invalid id" id)))))
;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
@@ -1501,7 +1486,7 @@
((vector? x)
(let ((old (vector->list x)))
(let ((new (map f old)))
- (if (andmap eq? old new) x (list->vector new)))))
+ (if (and-map* eq? old new) x (list->vector new)))))
(else x))))))
;;; lexical variables
@@ -1675,7 +1660,7 @@
; identity map equivalence:
; (map (lambda (x) x) y) == y
(car actuals))
- ((andmap
+ ((and-map
(lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
(cdr e))
; eta map equivalence:
@@ -1837,7 +1822,7 @@
(lambda (e)
(syntax-case e ()
((_ (mod ...) id)
- (and (andmap id? (syntax (mod ...))) (id? (syntax id)))
+ (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
(values (syntax->datum (syntax id))
(syntax->datum
(syntax (public mod ...))))))))
@@ -1846,7 +1831,7 @@
(lambda (e)
(syntax-case e ()
((_ (mod ...) id)
- (and (andmap id? (syntax (mod ...))) (id? (syntax id)))
+ (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
(values (syntax->datum (syntax id))
(syntax->datum
(syntax (private mod ...))))))))
@@ -1920,7 +1905,7 @@
(cond
((not (distinct-bound-ids? (map car pvars)))
(syntax-violation 'syntax-case "duplicate pattern variable"
pat))
- ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
+ ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
(syntax-violation 'syntax-case "misplaced ellipsis" pat))
(else
(let ((y (gen-var 'tmp)))
@@ -1954,8 +1939,8 @@
(syntax-case (car clauses) ()
((pat exp)
(if (and (id? (syntax pat))
- (andmap (lambda (x) (not (free-id=? (syntax pat) x)))
- (cons (syntax (... ...)) keys)))
+ (and-map (lambda (x) (not (free-id=? (syntax pat) x)))
+ (cons (syntax (... ...)) keys)))
(let ((labels (list (gen-label)))
(var (gen-var (syntax pat))))
(build-application no-source
@@ -1980,8 +1965,8 @@
(let ((e (source-wrap e w s mod)))
(syntax-case e ()
((_ val (key ...) m ...)
- (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x))))
- (syntax (key ...)))
+ (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x))))
+ (syntax (key ...)))
(let ((x (gen-var 'tmp)))
; fat finger binding and references to temp variable x
(build-application s
@@ -2071,12 +2056,6 @@
(if who (cons who tail) tail))
#f)))
-(set! install-global-transformer
- (lambda (sym v)
- (arg-check symbol? sym 'define-syntax)
- (arg-check procedure? v 'define-syntax)
- (global-extend 'macro sym v)))
-
;;; $sc-dispatch expects an expression and a pattern. If the expression
;;; matches the pattern a list of the matching expressions for each
;;; "any" is returned. Otherwise, #f is returned. (This use of #f will
@@ -2224,7 +2203,7 @@
(lambda (x)
(syntax-case x ()
((let* ((x v) ...) e1 e2 ...)
- (andmap identifier? (syntax (x ...)))
+ (and-map identifier? (syntax (x ...)))
(let f ((bindings (syntax ((x v) ...))))
(if (null? bindings)
(syntax (let () e1 e2 ...))
@@ -2325,20 +2304,20 @@
(syntax (begin exp ...))))))))
(define-syntax unquote
- (lambda (x)
- (syntax-case x ()
- ((_ e)
- (error 'unquote
- "expression ,~s not valid outside of quasiquote"
- (syntax->datum (syntax e)))))))
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e)
+ (syntax-violation 'unquote
+ "expression not valid outside of quasiquote"
+ x)))))
(define-syntax unquote-splicing
- (lambda (x)
- (syntax-case x ()
- ((_ e)
- (error 'unquote-splicing
- "expression ,@~s not valid outside of quasiquote"
- (syntax->datum (syntax e)))))))
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e)
+ (syntax-violation 'unquote-splicing
+ "expression not valid outside of quasiquote"
+ x)))))
(define-syntax case
(lambda (x)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 6a952e0ee9093424cdc8f300406d09ce195ebf5c,
Andy Wingo <=