diff --git a/libguile/eval.c b/libguile/eval.c index 19ac0b155..5b1473e06 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2140,6 +2140,25 @@ unmemoize_at_call_with_values (const SCM expr, const SCM env) unmemoize_exprs (SCM_CDR (expr), env)); } +SCM_SYNTAX (s_eval_when, "eval-when", scm_makmmacro, scm_m_eval_when); +SCM_GLOBAL_SYMBOL (scm_sym_eval_when, s_eval_when); +SCM_SYMBOL (sym_eval, "eval"); +SCM_SYMBOL (sym_load, "load"); + + +SCM +scm_m_eval_when (SCM expr, SCM env SCM_UNUSED) +{ + ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr); + ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr); + + if (scm_is_true (scm_memq (sym_eval, scm_cadr (expr))) + || scm_is_true (scm_memq (sym_load, scm_cadr (expr)))) + return scm_caddr (expr); + + return scm_list_1 (SCM_IM_BEGIN); +} + #if 0 /* See futures.h for a comment why futures are not enabled. diff --git a/libguile/eval.h b/libguile/eval.h index f3ec2e19c..b017f2e02 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -100,6 +100,7 @@ SCM_API SCM scm_sym_atapply; SCM_API SCM scm_sym_atcall_cc; SCM_API SCM scm_sym_at_call_with_values; SCM_API SCM scm_sym_delay; +SCM_API SCM scm_sym_eval_when; SCM_API SCM scm_sym_arrow; SCM_API SCM scm_sym_else; SCM_API SCM scm_sym_apply; @@ -146,6 +147,7 @@ SCM_API SCM scm_m_atslot_ref (SCM xorig, SCM env); SCM_API SCM scm_m_atslot_set_x (SCM xorig, SCM env); SCM_API SCM scm_m_atdispatch (SCM xorig, SCM env); SCM_API SCM scm_m_at_call_with_values (SCM xorig, SCM env); +SCM_API SCM scm_m_eval_when (SCM xorig, SCM env); SCM_API int scm_badargsp (SCM formals, SCM args); SCM_API SCM scm_call_0 (SCM proc); SCM_API SCM scm_call_1 (SCM proc, SCM arg1); diff --git a/module/Makefile.am b/module/Makefile.am index 95dc75ac2..2322828d7 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -35,15 +35,6 @@ SOURCES = \ system/base/pmatch.scm system/base/syntax.scm \ system/base/compile.scm system/base/language.scm \ \ - system/vm/debug.scm system/vm/frame.scm system/vm/instruction.scm \ - system/vm/objcode.scm system/vm/profile.scm system/vm/program.scm \ - system/vm/trace.scm system/vm/vm.scm \ - \ - system/xref.scm \ - \ - system/repl/repl.scm system/repl/common.scm \ - system/repl/command.scm \ - \ language/ghil.scm language/glil.scm language/assembly.scm \ \ $(SCHEME_LANG_SOURCES) $(ECMASCRIPT_LANG_SOURCES) \ @@ -54,7 +45,7 @@ SOURCES = \ $(ICE_9_SOURCES) \ $(SRFI_SOURCES) \ $(OOP_SOURCES) \ - \ + $(SYSTEM_SOURCES) \ $(SCRIPTS_SOURCES) ## test.scm is not currently installed. @@ -226,6 +217,16 @@ OOP_SOURCES = \ oop/goops/accessors.scm \ oop/goops/simple.scm +SYSTEM_SOURCES = \ + system/vm/debug.scm system/vm/frame.scm system/vm/instruction.scm \ + system/vm/objcode.scm system/vm/profile.scm system/vm/program.scm \ + system/vm/trace.scm system/vm/vm.scm \ + \ + system/xref.scm \ + \ + system/repl/repl.scm system/repl/common.scm \ + system/repl/command.scm + EXTRA_DIST += oop/ChangeLog-2008 NOCOMP_SOURCES = \ diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index a10c125f7..235d96c9a 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -33,6 +33,15 @@ +(define (void) (if #f #f)) + +;; Before compiling, make sure any symbols are resolved in the (guile) +;; module, the primary location of those symbols, rather than in +;; (guile-user), the default module that we compile in. + +(eval-when (compile) + (set-current-module (resolve-module '(guile)))) + ;;; {R4RS compliance} ;;; @@ -163,8 +172,6 @@ (define identifier? #f) (define syntax-object->datum #f) -(define (void) (if #f #f)) - (define andmap (lambda (f first . rest) (or (null? first) @@ -195,13 +202,6 @@ -;; Before compiling, make sure any symbols are resolved in the (guile) -;; module, the primary location of those symbols, rather than in -;; (guile-user), the default module that we compile in. - -(eval-when (compile) - (set-current-module (resolve-module '(guile)))) - ;;; {Defmacros} ;;; ;;; Depends on: features, eval-case diff --git a/module/ice-9/compile-psyntax.scm b/module/ice-9/compile-psyntax.scm index ac6683eb0..7091ef9fb 100644 --- a/module/ice-9/compile-psyntax.scm +++ b/module/ice-9/compile-psyntax.scm @@ -1,24 +1,18 @@ -;; XXX - We need to be inside (guile) since psyntax.ss calls -;; `eval' int he `interaction-environment' aka the current module and -;; it expects to have `andmap' there. The reason for this escapes me -;; at the moment. -;; -(define-module (guile)) - -(define source (list-ref (command-line) 1)) -(define target (list-ref (command-line) 2)) - -(let ((in (open-input-file source)) - (out (open-output-file (string-append target ".tmp")))) - (let loop ((x (read in))) - (if (eof-object? x) - (begin - (close-port out) - (close-port in)) - (begin - (write (sc-expand3 x 'c '(compile load eval)) - out) - (newline out) - (loop (read in)))))) - -(system (format #f "mv -f ~s.tmp ~s" target target)) +(let ((source (list-ref (command-line) 1)) + (target (list-ref (command-line) 2))) + (let ((in (open-input-file source)) + (out (open-output-file (string-append target ".tmp")))) + (write '(eval-when (compile) (set-current-module (resolve-module '(guile)))) + out) + (newline out) + (let loop ((x (read in))) + (if (eof-object? x) + (begin + (close-port out) + (close-port in)) + (begin + (write (sc-expand3 x 'c '(compile load eval)) + out) + (newline out) + (loop (read in)))))) + (system (format #f "mv -f ~s.tmp ~s" target target))) diff --git a/module/ice-9/networking.scm b/module/ice-9/networking.scm index c0218821f..9a30fc5b6 100644 --- a/module/ice-9/networking.scm +++ b/module/ice-9/networking.scm @@ -17,6 +17,9 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; +(eval-when (compile) + (set-current-module (resolve-module '(guile)))) + (define (gethostbyaddr addr) (gethost addr)) (define (gethostbyname name) (gethost name)) diff --git a/module/ice-9/posix.scm b/module/ice-9/posix.scm index 53d01a026..dd1a12690 100644 --- a/module/ice-9/posix.scm +++ b/module/ice-9/posix.scm @@ -17,6 +17,9 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; +(eval-when (compile) + (set-current-module (resolve-module '(guile)))) + (define (stat:dev f) (vector-ref f 0)) (define (stat:ino f) (vector-ref f 1)) (define (stat:mode f) (vector-ref f 2)) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 743197fbd..e402cddf0 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,3 +1,5 @@ +(eval-when (compile) (set-current-module (resolve-module (quote (guile))))) +(void) (letrec ((lambda-var-list1180 (lambda (vars1379) (let lvl1380 ((vars1381 vars1379) (ls1382 (quote ())) (w1383 (quote (())))) (cond ((pair? vars1381) (lvl1380 (cdr vars1381) (cons (wrap1159 (car vars1381) w1383 #f) ls1382) w1383)) ((id?1131 vars1381) (cons (wrap1159 vars1381 w1383 #f) ls1382)) ((null? vars1381) ls1382) ((syntax-object?1115 vars1381) (lvl1380 (syntax-object-expression1116 vars1381) ls1382 (join-wraps1150 w1383 (syntax-object-wrap1117 vars1381)))) ((annotation? vars1381) (lvl1380 (annotation-expression vars1381) ls1382 w1383)) (else (cons vars1381 ls1382)))))) (gen-var1179 (lambda (id1384) (let ((id1385 (if (syntax-object?1115 id1384) (syntax-object-expression1116 id1384) id1384))) (if (annotation? id1385) (build-annotated1108 (annotation-source id1385) (gensym (symbol->string (annotation-expression id1385)))) (build-annotated1108 #f (gensym (symbol->string id1385))))))) (strip1178 (lambda (x1386 w1387) (if (memq (quote top) (wrap-marks1134 w1387)) (if (or (annotation? x1386) (and (pair? x1386) (annotation? (car x1386)))) (strip-annotation1177 x1386 #f) x1386) (let f1388 ((x1389 x1386)) (cond ((syntax-object?1115 x1389) (strip1178 (syntax-object-expression1116 x1389) (syntax-object-wrap1117 x1389))) ((pair? x1389) (let ((a1390 (f1388 (car x1389))) (d1391 (f1388 (cdr x1389)))) (if (and (eq? a1390 (car x1389)) (eq? d1391 (cdr x1389))) x1389 (cons a1390 d1391)))) ((vector? x1389) (let ((old1392 (vector->list x1389))) (let ((new1393 (map f1388 old1392))) (if (andmap eq? old1392 new1393) x1389 (list->vector new1393))))) (else x1389)))))) (strip-annotation1177 (lambda (x1394 parent1395) (cond ((pair? x1394) (let ((new1396 (cons #f #f))) (begin (if parent1395 (set-annotation-stripped! parent1395 new1396)) (set-car! new1396 (strip-annotation1177 (car x1394) #f)) (set-cdr! new1396 (strip-annotation1177 (cdr x1394) #f)) new1396))) ((annotation? x1394) (or (annotation-stripped x1394) (strip-annotation1177 (annotation-expression x1394) x1394))) ((vector? x1394) (let ((new1397 (make-vector (vector-length x1394)))) (begin (if parent1395 (set-annotation-stripped! parent1395 new1397)) (let loop1398 ((i1399 (- (vector-length x1394) 1))) (unless (fx<1101 i1399 0) (vector-set! new1397 i1399 (strip-annotation1177 (vector-ref x1394 i1399) #f)) (loop1398 (fx-1099 i1399 1)))) new1397))) (else x1394)))) (ellipsis?1176 (lambda (x1400) (and (nonsymbol-id?1130 x1400) (free-id=?1154 x1400 (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1175 (lambda () (build-annotated1108 #f (list (build-annotated1108 #f (quote void)))))) (eval-local-transformer1174 (lambda (expanded1401 mod1402) (let ((p1403 (local-eval-hook1103 expanded1401 mod1402))) (if (procedure? p1403) p1403 (syntax-error p1403 "nonprocedure transformer"))))) (chi-local-syntax1173 (lambda (rec?1404 e1405 r1406 w1407 s1408 mod1409 k1410) ((lambda (tmp1411) ((lambda (tmp1412) (if tmp1412 (apply (lambda (_1413 id1414 val1415 e11416 e21417) (let ((ids1418 id1414)) (if (not (valid-bound-ids?1156 ids1418)) (syntax-error e1405 "duplicate bound keyword in") (let ((labels1420 (gen-labels1137 ids1418))) (let ((new-w1421 (make-binding-wrap1148 ids1418 labels1420 w1407))) (k1410 (cons e11416 e21417) (extend-env1125 labels1420 (let ((w1423 (if rec?1404 new-w1421 w1407)) (trans-r1424 (macros-only-env1127 r1406))) (map (lambda (x1425) (cons (quote macro) (eval-local-transformer1174 (chi1167 x1425 trans-r1424 w1423 mod1409) mod1409))) val1415)) r1406) new-w1421 s1408 mod1409)))))) tmp1412) ((lambda (_1427) (syntax-error (source-wrap1160 e1405 w1407 s1408 mod1409))) tmp1411))) (syntax-dispatch tmp1411 (quote (any #(each (any any)) any . each-any))))) e1405))) (chi-lambda-clause1172 (lambda (e1428 c1429 r1430 w1431 mod1432 k1433) ((lambda (tmp1434) ((lambda (tmp1435) (if tmp1435 (apply (lambda (id1436 e11437 e21438) (let ((ids1439 id1436)) (if (not (valid-bound-ids?1156 ids1439)) (syntax-error e1428 "invalid parameter list in") (let ((labels1441 (gen-labels1137 ids1439)) (new-vars1442 (map gen-var1179 ids1439))) (k1433 new-vars1442 (chi-body1171 (cons e11437 e21438) e1428 (extend-var-env1126 labels1441 new-vars1442 r1430) (make-binding-wrap1148 ids1439 labels1441 w1431) mod1432)))))) tmp1435) ((lambda (tmp1444) (if tmp1444 (apply (lambda (ids1445 e11446 e21447) (let ((old-ids1448 (lambda-var-list1180 ids1445))) (if (not (valid-bound-ids?1156 old-ids1448)) (syntax-error e1428 "invalid parameter list in") (let ((labels1449 (gen-labels1137 old-ids1448)) (new-vars1450 (map gen-var1179 old-ids1448))) (k1433 (let f1451 ((ls11452 (cdr new-vars1450)) (ls21453 (car new-vars1450))) (if (null? ls11452) ls21453 (f1451 (cdr ls11452) (cons (car ls11452) ls21453)))) (chi-body1171 (cons e11446 e21447) e1428 (extend-var-env1126 labels1449 new-vars1450 r1430) (make-binding-wrap1148 old-ids1448 labels1449 w1431) mod1432)))))) tmp1444) ((lambda (_1455) (syntax-error e1428)) tmp1434))) (syntax-dispatch tmp1434 (quote (any any . each-any)))))) (syntax-dispatch tmp1434 (quote (each-any any . each-any))))) c1429))) (chi-body1171 (lambda (body1456 outer-form1457 r1458 w1459 mod1460) (let ((r1461 (cons (quote ("placeholder" placeholder)) r1458))) (let ((ribcage1462 (make-ribcage1138 (quote ()) (quote ()) (quote ())))) (let ((w1463 (make-wrap1133 (wrap-marks1134 w1459) (cons ribcage1462 (wrap-subst1135 w1459))))) (let parse1464 ((body1465 (map (lambda (x1471) (cons r1461 (wrap1159 x1471 w1463 mod1460))) body1456)) (ids1466 (quote ())) (labels1467 (quote ())) (vars1468 (quote ())) (vals1469 (quote ())) (bindings1470 (quote ()))) (if (null? body1465) (syntax-error outer-form1457 "no expressions in body") (let ((e1472 (cdar body1465)) (er1473 (caar body1465))) (call-with-values (lambda () (syntax-type1165 e1472 er1473 (quote (())) #f ribcage1462 mod1460)) (lambda (type1474 value1475 e1476 w1477 s1478 mod1479) (let ((t1480 type1474)) (if (memv t1480 (quote (define-form))) (let ((id1481 (wrap1159 value1475 w1477 mod1479)) (label1482 (gen-label1136))) (let ((var1483 (gen-var1179 id1481))) (begin (extend-ribcage!1147 ribcage1462 id1481 label1482) (parse1464 (cdr body1465) (cons id1481 ids1466) (cons label1482 labels1467) (cons var1483 vars1468) (cons (cons er1473 (wrap1159 e1476 w1477 mod1479)) vals1469) (cons (cons (quote lexical) var1483) bindings1470))))) (if (memv t1480 (quote (define-syntax-form))) (let ((id1484 (wrap1159 value1475 w1477 mod1479)) (label1485 (gen-label1136))) (begin (extend-ribcage!1147 ribcage1462 id1484 label1485) (parse1464 (cdr body1465) (cons id1484 ids1466) (cons label1485 labels1467) vars1468 vals1469 (cons (cons (quote macro) (cons er1473 (wrap1159 e1476 w1477 mod1479))) bindings1470)))) (if (memv t1480 (quote (begin-form))) ((lambda (tmp1486) ((lambda (tmp1487) (if tmp1487 (apply (lambda (_1488 e11489) (parse1464 (let f1490 ((forms1491 e11489)) (if (null? forms1491) (cdr body1465) (cons (cons er1473 (wrap1159 (car forms1491) w1477 mod1479)) (f1490 (cdr forms1491))))) ids1466 labels1467 vars1468 vals1469 bindings1470)) tmp1487) (syntax-error tmp1486))) (syntax-dispatch tmp1486 (quote (any . each-any))))) e1476) (if (memv t1480 (quote (local-syntax-form))) (chi-local-syntax1173 value1475 e1476 er1473 w1477 s1478 mod1479 (lambda (forms1493 er1494 w1495 s1496 mod1497) (parse1464 (let f1498 ((forms1499 forms1493)) (if (null? forms1499) (cdr body1465) (cons (cons er1494 (wrap1159 (car forms1499) w1495 mod1497)) (f1498 (cdr forms1499))))) ids1466 labels1467 vars1468 vals1469 bindings1470))) (if (null? ids1466) (build-sequence1110 #f (map (lambda (x1500) (chi1167 (cdr x1500) (car x1500) (quote (())) mod1479)) (cons (cons er1473 (source-wrap1160 e1476 w1477 s1478 mod1479)) (cdr body1465)))) (begin (if (not (valid-bound-ids?1156 ids1466)) (syntax-error outer-form1457 "invalid or duplicate identifier in definition")) (let loop1501 ((bs1502 bindings1470) (er-cache1503 #f) (r-cache1504 #f)) (if (not (null? bs1502)) (let ((b1505 (car bs1502))) (if (eq? (car b1505) (quote macro)) (let ((er1506 (cadr b1505))) (let ((r-cache1507 (if (eq? er1506 er-cache1503) r-cache1504 (macros-only-env1127 er1506)))) (begin (set-cdr! b1505 (eval-local-transformer1174 (chi1167 (cddr b1505) r-cache1507 (quote (())) mod1479) mod1479)) (loop1501 (cdr bs1502) er1506 r-cache1507)))) (loop1501 (cdr bs1502) er-cache1503 r-cache1504))))) (set-cdr! r1461 (extend-env1125 labels1467 bindings1470 (cdr r1461))) (build-letrec1113 #f vars1468 (map (lambda (x1508) (chi1167 (cdr x1508) (car x1508) (quote (())) mod1479)) vals1469) (build-sequence1110 #f (map (lambda (x1509) (chi1167 (cdr x1509) (car x1509) (quote (())) mod1479)) (cons (cons er1473 (source-wrap1160 e1476 w1477 s1478 mod1479)) (cdr body1465)))))))))))))))))))))) (chi-macro1170 (lambda (p1510 e1511 r1512 w1513 rib1514 mod1515) (letrec ((rebuild-macro-output1516 (lambda (x1517 m1518) (cond ((pair? x1517) (cons (rebuild-macro-output1516 (car x1517) m1518) (rebuild-macro-output1516 (cdr x1517) m1518))) ((syntax-object?1115 x1517) (let ((w1519 (syntax-object-wrap1117 x1517))) (let ((ms1520 (wrap-marks1134 w1519)) (s1521 (wrap-subst1135 w1519))) (if (and (pair? ms1520) (eq? (car ms1520) #f)) (make-syntax-object1114 (syntax-object-expression1116 x1517) (make-wrap1133 (cdr ms1520) (if rib1514 (cons rib1514 (cdr s1521)) (cdr s1521))) (syntax-object-module1118 x1517)) (make-syntax-object1114 (syntax-object-expression1116 x1517) (make-wrap1133 (cons m1518 ms1520) (if rib1514 (cons rib1514 (cons (quote shift) s1521)) (cons (quote shift) s1521))) (let ((pmod1522 (procedure-module p1510))) (if pmod1522 (cons (quote hygiene) (module-name pmod1522)) (quote (hygiene guile))))))))) ((vector? x1517) (let ((n1523 (vector-length x1517))) (let ((v1524 (make-vector n1523))) (let doloop1525 ((i1526 0)) (if (fx=1100 i1526 n1523) v1524 (begin (vector-set! v1524 i1526 (rebuild-macro-output1516 (vector-ref x1517 i1526) m1518)) (doloop1525 (fx+1098 i1526 1)))))))) ((symbol? x1517) (syntax-error x1517 "encountered raw symbol in macro output")) (else x1517))))) (rebuild-macro-output1516 (p1510 (wrap1159 e1511 (anti-mark1146 w1513) mod1515)) (string #\m))))) (chi-application1169 (lambda (x1527 e1528 r1529 w1530 s1531 mod1532) ((lambda (tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (e01535 e11536) (build-annotated1108 s1531 (cons x1527 (map (lambda (e1537) (chi1167 e1537 r1529 w1530 mod1532)) e11536)))) tmp1534) (syntax-error tmp1533))) (syntax-dispatch tmp1533 (quote (any . each-any))))) e1528))) (chi-expr1168 (lambda (type1539 value1540 e1541 r1542 w1543 s1544 mod1545) (let ((t1546 type1539)) (if (memv t1546 (quote (lexical))) (build-annotated1108 s1544 value1540) (if (memv t1546 (quote (core external-macro))) (value1540 e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (module-ref))) (call-with-values (lambda () (value1540 e1541)) (lambda (id1547 mod1548) (build-annotated1108 s1544 (if mod1548 (make-module-ref (cdr mod1548) id1547 (car mod1548)) (make-module-ref mod1548 id1547 (quote bare)))))) (if (memv t1546 (quote (lexical-call))) (chi-application1169 (build-annotated1108 (source-annotation1122 (car e1541)) value1540) e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (global-call))) (chi-application1169 (build-annotated1108 (source-annotation1122 (car e1541)) (if (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545) (make-module-ref (cdr (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545)) value1540 (car (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545))) (make-module-ref (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545) value1540 (quote bare)))) e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (constant))) (build-data1109 s1544 (strip1178 (source-wrap1160 e1541 w1543 s1544 mod1545) (quote (())))) (if (memv t1546 (quote (global))) (build-annotated1108 s1544 (if mod1545 (make-module-ref (cdr mod1545) value1540 (car mod1545)) (make-module-ref mod1545 value1540 (quote bare)))) (if (memv t1546 (quote (call))) (chi-application1169 (chi1167 (car e1541) r1542 w1543 mod1545) e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (begin-form))) ((lambda (tmp1549) ((lambda (tmp1550) (if tmp1550 (apply (lambda (_1551 e11552 e21553) (chi-sequence1161 (cons e11552 e21553) r1542 w1543 s1544 mod1545)) tmp1550) (syntax-error tmp1549))) (syntax-dispatch tmp1549 (quote (any any . each-any))))) e1541) (if (memv t1546 (quote (local-syntax-form))) (chi-local-syntax1173 value1540 e1541 r1542 w1543 s1544 mod1545 chi-sequence1161) (if (memv t1546 (quote (eval-when-form))) ((lambda (tmp1555) ((lambda (tmp1556) (if tmp1556 (apply (lambda (_1557 x1558 e11559 e21560) (let ((when-list1561 (chi-when-list1164 e1541 x1558 w1543))) (if (memq (quote eval) when-list1561) (chi-sequence1161 (cons e11559 e21560) r1542 w1543 s1544 mod1545) (chi-void1175)))) tmp1556) (syntax-error tmp1555))) (syntax-dispatch tmp1555 (quote (any each-any any . each-any))))) e1541) (if (memv t1546 (quote (define-form define-syntax-form))) (syntax-error (wrap1159 value1540 w1543 mod1545) "invalid context for definition of") (if (memv t1546 (quote (syntax))) (syntax-error (source-wrap1160 e1541 w1543 s1544 mod1545) "reference to pattern variable outside syntax form") (if (memv t1546 (quote (displaced-lexical))) (syntax-error (source-wrap1160 e1541 w1543 s1544 mod1545) "reference to identifier outside its scope") (syntax-error (source-wrap1160 e1541 w1543 s1544 mod1545))))))))))))))))))) (chi1167 (lambda (e1564 r1565 w1566 mod1567) (call-with-values (lambda () (syntax-type1165 e1564 r1565 w1566 #f #f mod1567)) (lambda (type1568 value1569 e1570 w1571 s1572 mod1573) (chi-expr1168 type1568 value1569 e1570 r1565 w1571 s1572 mod1573))))) (chi-top1166 (lambda (e1574 r1575 w1576 m1577 esew1578 mod1579) (call-with-values (lambda () (syntax-type1165 e1574 r1575 w1576 #f #f mod1579)) (lambda (type1587 value1588 e1589 w1590 s1591 mod1592) (let ((t1593 type1587)) (if (memv t1593 (quote (begin-form))) ((lambda (tmp1594) ((lambda (tmp1595) (if tmp1595 (apply (lambda (_1596) (chi-void1175)) tmp1595) ((lambda (tmp1597) (if tmp1597 (apply (lambda (_1598 e11599 e21600) (chi-top-sequence1162 (cons e11599 e21600) r1575 w1590 s1591 m1577 esew1578 mod1592)) tmp1597) (syntax-error tmp1594))) (syntax-dispatch tmp1594 (quote (any any . each-any)))))) (syntax-dispatch tmp1594 (quote (any))))) e1589) (if (memv t1593 (quote (local-syntax-form))) (chi-local-syntax1173 value1588 e1589 r1575 w1590 s1591 mod1592 (lambda (body1602 r1603 w1604 s1605 mod1606) (chi-top-sequence1162 body1602 r1603 w1604 s1605 m1577 esew1578 mod1606))) (if (memv t1593 (quote (eval-when-form))) ((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (_1609 x1610 e11611 e21612) (let ((when-list1613 (chi-when-list1164 e1589 x1610 w1590)) (body1614 (cons e11611 e21612))) (cond ((eq? m1577 (quote e)) (if (memq (quote eval) when-list1613) (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote e) (quote (eval)) mod1592) (chi-void1175))) ((memq (quote load) when-list1613) (if (or (memq (quote compile) when-list1613) (and (eq? m1577 (quote c&e)) (memq (quote eval) when-list1613))) (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote c&e) (quote (compile load)) mod1592) (if (memq m1577 (quote (c c&e))) (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote c) (quote (load)) mod1592) (chi-void1175)))) ((or (memq (quote compile) when-list1613) (and (eq? m1577 (quote c&e)) (memq (quote eval) when-list1613))) (top-level-eval-hook1102 (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote e) (quote (eval)) mod1592) mod1592) (chi-void1175)) (else (chi-void1175))))) tmp1608) (syntax-error tmp1607))) (syntax-dispatch tmp1607 (quote (any each-any any . each-any))))) e1589) (if (memv t1593 (quote (define-syntax-form))) (let ((n1617 (id-var-name1153 value1588 w1590)) (r1618 (macros-only-env1127 r1575))) (let ((t1619 m1577)) (if (memv t1619 (quote (c))) (if (memq (quote compile) esew1578) (let ((e1620 (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)))) (begin (top-level-eval-hook1102 e1620 mod1592) (if (memq (quote load) esew1578) e1620 (chi-void1175)))) (if (memq (quote load) esew1578) (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)) (chi-void1175))) (if (memv t1619 (quote (c&e))) (let ((e1621 (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)))) (begin (top-level-eval-hook1102 e1621 mod1592) e1621)) (begin (if (memq (quote eval) esew1578) (top-level-eval-hook1102 (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)) mod1592)) (chi-void1175)))))) (if (memv t1593 (quote (define-form))) (let ((n1622 (id-var-name1153 value1588 w1590))) (let ((type1623 (binding-type1123 (lookup1128 n1622 r1575 mod1592)))) (let ((t1624 type1623)) (if (memv t1624 (quote (global))) (let ((x1625 (build-annotated1108 s1591 (list (quote define) n1622 (chi1167 e1589 r1575 w1590 mod1592))))) (begin (if (eq? m1577 (quote c&e)) (top-level-eval-hook1102 x1625 mod1592)) x1625)) (if (memv t1624 (quote (displaced-lexical))) (syntax-error (wrap1159 value1588 w1590 mod1592) "identifier out of context") (if (memv t1624 (quote (core macro module-ref))) (begin (remove-global-definition-hook1106 n1622) (let ((x1626 (build-annotated1108 s1591 (list (quote define) n1622 (chi1167 e1589 r1575 w1590 mod1592))))) (begin (if (eq? m1577 (quote c&e)) (top-level-eval-hook1102 x1626 mod1592)) x1626))) (syntax-error (wrap1159 value1588 w1590 mod1592) "cannot define keyword at top level"))))))) (let ((x1627 (chi-expr1168 type1587 value1588 e1589 r1575 w1590 s1591 mod1592))) (begin (if (eq? m1577 (quote c&e)) (top-level-eval-hook1102 x1627 mod1592)) x1627)))))))))))) (syntax-type1165 (lambda (e1628 r1629 w1630 s1631 rib1632 mod1633) (cond ((symbol? e1628) (let ((n1634 (id-var-name1153 e1628 w1630))) (let ((b1635 (lookup1128 n1634 r1629 mod1633))) (let ((type1636 (binding-type1123 b1635))) (let ((t1637 type1636)) (if (memv t1637 (quote (lexical))) (values type1636 (binding-value1124 b1635) e1628 w1630 s1631 mod1633) (if (memv t1637 (quote (global))) (values type1636 n1634 e1628 w1630 s1631 mod1633) (if (memv t1637 (quote (macro))) (syntax-type1165 (chi-macro1170 (binding-value1124 b1635) e1628 r1629 w1630 rib1632 mod1633) r1629 (quote (())) s1631 rib1632 mod1633) (values type1636 (binding-value1124 b1635) e1628 w1630 s1631 mod1633))))))))) ((pair? e1628) (let ((first1638 (car e1628))) (if (id?1131 first1638) (let ((n1639 (id-var-name1153 first1638 w1630))) (let ((b1640 (lookup1128 n1639 r1629 (or (and (syntax-object?1115 first1638) (syntax-object-module1118 first1638)) mod1633)))) (let ((type1641 (binding-type1123 b1640))) (let ((t1642 type1641)) (if (memv t1642 (quote (lexical))) (values (quote lexical-call) (binding-value1124 b1640) e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (global))) (values (quote global-call) n1639 e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (macro))) (syntax-type1165 (chi-macro1170 (binding-value1124 b1640) e1628 r1629 w1630 rib1632 mod1633) r1629 (quote (())) s1631 rib1632 mod1633) (if (memv t1642 (quote (core external-macro module-ref))) (values type1641 (binding-value1124 b1640) e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1124 b1640) e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (begin))) (values (quote begin-form) #f e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (eval-when))) (values (quote eval-when-form) #f e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (define))) ((lambda (tmp1643) ((lambda (tmp1644) (if (if tmp1644 (apply (lambda (_1645 name1646 val1647) (id?1131 name1646)) tmp1644) #f) (apply (lambda (_1648 name1649 val1650) (values (quote define-form) name1649 val1650 w1630 s1631 mod1633)) tmp1644) ((lambda (tmp1651) (if (if tmp1651 (apply (lambda (_1652 name1653 args1654 e11655 e21656) (and (id?1131 name1653) (valid-bound-ids?1156 (lambda-var-list1180 args1654)))) tmp1651) #f) (apply (lambda (_1657 name1658 args1659 e11660 e21661) (values (quote define-form) (wrap1159 name1658 w1630 mod1633) (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1159 (cons args1659 (cons e11660 e21661)) w1630 mod1633)) (quote (())) s1631 mod1633)) tmp1651) ((lambda (tmp1663) (if (if tmp1663 (apply (lambda (_1664 name1665) (id?1131 name1665)) tmp1663) #f) (apply (lambda (_1666 name1667) (values (quote define-form) (wrap1159 name1667 w1630 mod1633) (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1631 mod1633)) tmp1663) (syntax-error tmp1643))) (syntax-dispatch tmp1643 (quote (any any)))))) (syntax-dispatch tmp1643 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1643 (quote (any any any))))) e1628) (if (memv t1642 (quote (define-syntax))) ((lambda (tmp1668) ((lambda (tmp1669) (if (if tmp1669 (apply (lambda (_1670 name1671 val1672) (id?1131 name1671)) tmp1669) #f) (apply (lambda (_1673 name1674 val1675) (values (quote define-syntax-form) name1674 val1675 w1630 s1631 mod1633)) tmp1669) (syntax-error tmp1668))) (syntax-dispatch tmp1668 (quote (any any any))))) e1628) (values (quote call) #f e1628 w1630 s1631 mod1633)))))))))))))) (values (quote call) #f e1628 w1630 s1631 mod1633)))) ((syntax-object?1115 e1628) (syntax-type1165 (syntax-object-expression1116 e1628) r1629 (join-wraps1150 w1630 (syntax-object-wrap1117 e1628)) #f rib1632 (or (syntax-object-module1118 e1628) mod1633))) ((annotation? e1628) (syntax-type1165 (annotation-expression e1628) r1629 w1630 (annotation-source e1628) rib1632 mod1633)) ((self-evaluating? e1628) (values (quote constant) #f e1628 w1630 s1631 mod1633)) (else (values (quote other) #f e1628 w1630 s1631 mod1633))))) (chi-when-list1164 (lambda (e1676 when-list1677 w1678) (let f1679 ((when-list1680 when-list1677) (situations1681 (quote ()))) (if (null? when-list1680) situations1681 (f1679 (cdr when-list1680) (cons (let ((x1682 (car when-list1680))) (cond ((free-id=?1154 x1682 (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1154 x1682 (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1154 x1682 (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-error (wrap1159 x1682 w1678 #f) "invalid eval-when situation")))) situations1681)))))) (chi-install-global1163 (lambda (name1683 e1684) (build-annotated1108 #f (list (build-annotated1108 #f (quote install-global-transformer)) (build-data1109 #f name1683) e1684)))) (chi-top-sequence1162 (lambda (body1685 r1686 w1687 s1688 m1689 esew1690 mod1691) (build-sequence1110 s1688 (let dobody1692 ((body1693 body1685) (r1694 r1686) (w1695 w1687) (m1696 m1689) (esew1697 esew1690) (mod1698 mod1691)) (if (null? body1693) (quote ()) (let ((first1699 (chi-top1166 (car body1693) r1694 w1695 m1696 esew1697 mod1698))) (cons first1699 (dobody1692 (cdr body1693) r1694 w1695 m1696 esew1697 mod1698)))))))) (chi-sequence1161 (lambda (body1700 r1701 w1702 s1703 mod1704) (build-sequence1110 s1703 (let dobody1705 ((body1706 body1700) (r1707 r1701) (w1708 w1702) (mod1709 mod1704)) (if (null? body1706) (quote ()) (let ((first1710 (chi1167 (car body1706) r1707 w1708 mod1709))) (cons first1710 (dobody1705 (cdr body1706) r1707 w1708 mod1709)))))))) (source-wrap1160 (lambda (x1711 w1712 s1713 defmod1714) (wrap1159 (if s1713 (make-annotation x1711 s1713 #f) x1711) w1712 defmod1714))) (wrap1159 (lambda (x1715 w1716 defmod1717) (cond ((and (null? (wrap-marks1134 w1716)) (null? (wrap-subst1135 w1716))) x1715) ((syntax-object?1115 x1715) (make-syntax-object1114 (syntax-object-expression1116 x1715) (join-wraps1150 w1716 (syntax-object-wrap1117 x1715)) (syntax-object-module1118 x1715))) ((null? x1715) x1715) (else (make-syntax-object1114 x1715 w1716 defmod1717))))) (bound-id-member?1158 (lambda (x1718 list1719) (and (not (null? list1719)) (or (bound-id=?1155 x1718 (car list1719)) (bound-id-member?1158 x1718 (cdr list1719)))))) (distinct-bound-ids?1157 (lambda (ids1720) (let distinct?1721 ((ids1722 ids1720)) (or (null? ids1722) (and (not (bound-id-member?1158 (car ids1722) (cdr ids1722))) (distinct?1721 (cdr ids1722))))))) (valid-bound-ids?1156 (lambda (ids1723) (and (let all-ids?1724 ((ids1725 ids1723)) (or (null? ids1725) (and (id?1131 (car ids1725)) (all-ids?1724 (cdr ids1725))))) (distinct-bound-ids?1157 ids1723)))) (bound-id=?1155 (lambda (i1726 j1727) (if (and (syntax-object?1115 i1726) (syntax-object?1115 j1727)) (and (eq? (let ((e1728 (syntax-object-expression1116 i1726))) (if (annotation? e1728) (annotation-expression e1728) e1728)) (let ((e1729 (syntax-object-expression1116 j1727))) (if (annotation? e1729) (annotation-expression e1729) e1729))) (same-marks?1152 (wrap-marks1134 (syntax-object-wrap1117 i1726)) (wrap-marks1134 (syntax-object-wrap1117 j1727)))) (eq? (let ((e1730 i1726)) (if (annotation? e1730) (annotation-expression e1730) e1730)) (let ((e1731 j1727)) (if (annotation? e1731) (annotation-expression e1731) e1731)))))) (free-id=?1154 (lambda (i1732 j1733) (and (eq? (let ((x1734 i1732)) (let ((e1735 (if (syntax-object?1115 x1734) (syntax-object-expression1116 x1734) x1734))) (if (annotation? e1735) (annotation-expression e1735) e1735))) (let ((x1736 j1733)) (let ((e1737 (if (syntax-object?1115 x1736) (syntax-object-expression1116 x1736) x1736))) (if (annotation? e1737) (annotation-expression e1737) e1737)))) (eq? (id-var-name1153 i1732 (quote (()))) (id-var-name1153 j1733 (quote (()))))))) (id-var-name1153 (lambda (id1738 w1739) (letrec ((search-vector-rib1742 (lambda (sym1748 subst1749 marks1750 symnames1751 ribcage1752) (let ((n1753 (vector-length symnames1751))) (let f1754 ((i1755 0)) (cond ((fx=1100 i1755 n1753) (search1740 sym1748 (cdr subst1749) marks1750)) ((and (eq? (vector-ref symnames1751 i1755) sym1748) (same-marks?1152 marks1750 (vector-ref (ribcage-marks1141 ribcage1752) i1755))) (values (vector-ref (ribcage-labels1142 ribcage1752) i1755) marks1750)) (else (f1754 (fx+1098 i1755 1)))))))) (search-list-rib1741 (lambda (sym1756 subst1757 marks1758 symnames1759 ribcage1760) (let f1761 ((symnames1762 symnames1759) (i1763 0)) (cond ((null? symnames1762) (search1740 sym1756 (cdr subst1757) marks1758)) ((and (eq? (car symnames1762) sym1756) (same-marks?1152 marks1758 (list-ref (ribcage-marks1141 ribcage1760) i1763))) (values (list-ref (ribcage-labels1142 ribcage1760) i1763) marks1758)) (else (f1761 (cdr symnames1762) (fx+1098 i1763 1))))))) (search1740 (lambda (sym1764 subst1765 marks1766) (if (null? subst1765) (values #f marks1766) (let ((fst1767 (car subst1765))) (if (eq? fst1767 (quote shift)) (search1740 sym1764 (cdr subst1765) (cdr marks1766)) (let ((symnames1768 (ribcage-symnames1140 fst1767))) (if (vector? symnames1768) (search-vector-rib1742 sym1764 subst1765 marks1766 symnames1768 fst1767) (search-list-rib1741 sym1764 subst1765 marks1766 symnames1768 fst1767))))))))) (cond ((symbol? id1738) (or (call-with-values (lambda () (search1740 id1738 (wrap-subst1135 w1739) (wrap-marks1134 w1739))) (lambda (x1770 . ignore1769) x1770)) id1738)) ((syntax-object?1115 id1738) (let ((id1771 (let ((e1773 (syntax-object-expression1116 id1738))) (if (annotation? e1773) (annotation-expression e1773) e1773))) (w11772 (syntax-object-wrap1117 id1738))) (let ((marks1774 (join-marks1151 (wrap-marks1134 w1739) (wrap-marks1134 w11772)))) (call-with-values (lambda () (search1740 id1771 (wrap-subst1135 w1739) marks1774)) (lambda (new-id1775 marks1776) (or new-id1775 (call-with-values (lambda () (search1740 id1771 (wrap-subst1135 w11772) marks1776)) (lambda (x1778 . ignore1777) x1778)) id1771)))))) ((annotation? id1738) (let ((id1779 (let ((e1780 id1738)) (if (annotation? e1780) (annotation-expression e1780) e1780)))) (or (call-with-values (lambda () (search1740 id1779 (wrap-subst1135 w1739) (wrap-marks1134 w1739))) (lambda (x1782 . ignore1781) x1782)) id1779))) (else (error-hook1104 (quote id-var-name) "invalid id" id1738)))))) (same-marks?1152 (lambda (x1783 y1784) (or (eq? x1783 y1784) (and (not (null? x1783)) (not (null? y1784)) (eq? (car x1783) (car y1784)) (same-marks?1152 (cdr x1783) (cdr y1784)))))) (join-marks1151 (lambda (m11785 m21786) (smart-append1149 m11785 m21786))) (join-wraps1150 (lambda (w11787 w21788) (let ((m11789 (wrap-marks1134 w11787)) (s11790 (wrap-subst1135 w11787))) (if (null? m11789) (if (null? s11790) w21788 (make-wrap1133 (wrap-marks1134 w21788) (smart-append1149 s11790 (wrap-subst1135 w21788)))) (make-wrap1133 (smart-append1149 m11789 (wrap-marks1134 w21788)) (smart-append1149 s11790 (wrap-subst1135 w21788))))))) (smart-append1149 (lambda (m11791 m21792) (if (null? m21792) m11791 (append m11791 m21792)))) (make-binding-wrap1148 (lambda (ids1793 labels1794 w1795) (if (null? ids1793) w1795 (make-wrap1133 (wrap-marks1134 w1795) (cons (let ((labelvec1796 (list->vector labels1794))) (let ((n1797 (vector-length labelvec1796))) (let ((symnamevec1798 (make-vector n1797)) (marksvec1799 (make-vector n1797))) (begin (let f1800 ((ids1801 ids1793) (i1802 0)) (if (not (null? ids1801)) (call-with-values (lambda () (id-sym-name&marks1132 (car ids1801) w1795)) (lambda (symname1803 marks1804) (begin (vector-set! symnamevec1798 i1802 symname1803) (vector-set! marksvec1799 i1802 marks1804) (f1800 (cdr ids1801) (fx+1098 i1802 1))))))) (make-ribcage1138 symnamevec1798 marksvec1799 labelvec1796))))) (wrap-subst1135 w1795)))))) (extend-ribcage!1147 (lambda (ribcage1805 id1806 label1807) (begin (set-ribcage-symnames!1143 ribcage1805 (cons (let ((e1808 (syntax-object-expression1116 id1806))) (if (annotation? e1808) (annotation-expression e1808) e1808)) (ribcage-symnames1140 ribcage1805))) (set-ribcage-marks!1144 ribcage1805 (cons (wrap-marks1134 (syntax-object-wrap1117 id1806)) (ribcage-marks1141 ribcage1805))) (set-ribcage-labels!1145 ribcage1805 (cons label1807 (ribcage-labels1142 ribcage1805)))))) (anti-mark1146 (lambda (w1809) (make-wrap1133 (cons #f (wrap-marks1134 w1809)) (cons (quote shift) (wrap-subst1135 w1809))))) (set-ribcage-labels!1145 (lambda (x1810 update1811) (vector-set! x1810 3 update1811))) (set-ribcage-marks!1144 (lambda (x1812 update1813) (vector-set! x1812 2 update1813))) (set-ribcage-symnames!1143 (lambda (x1814 update1815) (vector-set! x1814 1 update1815))) (ribcage-labels1142 (lambda (x1816) (vector-ref x1816 3))) (ribcage-marks1141 (lambda (x1817) (vector-ref x1817 2))) (ribcage-symnames1140 (lambda (x1818) (vector-ref x1818 1))) (ribcage?1139 (lambda (x1819) (and (vector? x1819) (= (vector-length x1819) 4) (eq? (vector-ref x1819 0) (quote ribcage))))) (make-ribcage1138 (lambda (symnames1820 marks1821 labels1822) (vector (quote ribcage) symnames1820 marks1821 labels1822))) (gen-labels1137 (lambda (ls1823) (if (null? ls1823) (quote ()) (cons (gen-label1136) (gen-labels1137 (cdr ls1823)))))) (gen-label1136 (lambda () (string #\i))) (wrap-subst1135 cdr) (wrap-marks1134 car) (make-wrap1133 cons) (id-sym-name&marks1132 (lambda (x1824 w1825) (if (syntax-object?1115 x1824) (values (let ((e1826 (syntax-object-expression1116 x1824))) (if (annotation? e1826) (annotation-expression e1826) e1826)) (join-marks1151 (wrap-marks1134 w1825) (wrap-marks1134 (syntax-object-wrap1117 x1824)))) (values (let ((e1827 x1824)) (if (annotation? e1827) (annotation-expression e1827) e1827)) (wrap-marks1134 w1825))))) (id?1131 (lambda (x1828) (cond ((symbol? x1828) #t) ((syntax-object?1115 x1828) (symbol? (let ((e1829 (syntax-object-expression1116 x1828))) (if (annotation? e1829) (annotation-expression e1829) e1829)))) ((annotation? x1828) (symbol? (annotation-expression x1828))) (else #f)))) (nonsymbol-id?1130 (lambda (x1830) (and (syntax-object?1115 x1830) (symbol? (let ((e1831 (syntax-object-expression1116 x1830))) (if (annotation? e1831) (annotation-expression e1831) e1831)))))) (global-extend1129 (lambda (type1832 sym1833 val1834) (put-global-definition-hook1105 sym1833 (cons type1832 val1834)))) (lookup1128 (lambda (x1835 r1836 mod1837) (cond ((assq x1835 r1836) => cdr) ((symbol? x1835) (or (get-global-definition-hook1107 x1835 mod1837) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1127 (lambda (r1838) (if (null? r1838) (quote ()) (let ((a1839 (car r1838))) (if (eq? (cadr a1839) (quote macro)) (cons a1839 (macros-only-env1127 (cdr r1838))) (macros-only-env1127 (cdr r1838))))))) (extend-var-env1126 (lambda (labels1840 vars1841 r1842) (if (null? labels1840) r1842 (extend-var-env1126 (cdr labels1840) (cdr vars1841) (cons (cons (car labels1840) (cons (quote lexical) (car vars1841))) r1842))))) (extend-env1125 (lambda (labels1843 bindings1844 r1845) (if (null? labels1843) r1845 (extend-env1125 (cdr labels1843) (cdr bindings1844) (cons (cons (car labels1843) (car bindings1844)) r1845))))) (binding-value1124 cdr) (binding-type1123 car) (source-annotation1122 (lambda (x1846) (cond ((annotation? x1846) (annotation-source x1846)) ((syntax-object?1115 x1846) (source-annotation1122 (syntax-object-expression1116 x1846))) (else #f)))) (set-syntax-object-module!1121 (lambda (x1847 update1848) (vector-set! x1847 3 update1848))) (set-syntax-object-wrap!1120 (lambda (x1849 update1850) (vector-set! x1849 2 update1850))) (set-syntax-object-expression!1119 (lambda (x1851 update1852) (vector-set! x1851 1 update1852))) (syntax-object-module1118 (lambda (x1853) (vector-ref x1853 3))) (syntax-object-wrap1117 (lambda (x1854) (vector-ref x1854 2))) (syntax-object-expression1116 (lambda (x1855) (vector-ref x1855 1))) (syntax-object?1115 (lambda (x1856) (and (vector? x1856) (= (vector-length x1856) 4) (eq? (vector-ref x1856 0) (quote syntax-object))))) (make-syntax-object1114 (lambda (expression1857 wrap1858 module1859) (vector (quote syntax-object) expression1857 wrap1858 module1859))) (build-letrec1113 (lambda (src1860 vars1861 val-exps1862 body-exp1863) (if (null? vars1861) (build-annotated1108 src1860 body-exp1863) (build-annotated1108 src1860 (list (quote letrec) (map list vars1861 val-exps1862) body-exp1863))))) (build-named-let1112 (lambda (src1864 vars1865 val-exps1866 body-exp1867) (if (null? vars1865) (build-annotated1108 src1864 body-exp1867) (build-annotated1108 src1864 (list (quote let) (car vars1865) (map list (cdr vars1865) val-exps1866) body-exp1867))))) (build-let1111 (lambda (src1868 vars1869 val-exps1870 body-exp1871) (if (null? vars1869) (build-annotated1108 src1868 body-exp1871) (build-annotated1108 src1868 (list (quote let) (map list vars1869 val-exps1870) body-exp1871))))) (build-sequence1110 (lambda (src1872 exps1873) (if (null? (cdr exps1873)) (build-annotated1108 src1872 (car exps1873)) (build-annotated1108 src1872 (cons (quote begin) exps1873))))) (build-data1109 (lambda (src1874 exp1875) (if (and (self-evaluating? exp1875) (not (vector? exp1875))) (build-annotated1108 src1874 exp1875) (build-annotated1108 src1874 (list (quote quote) exp1875))))) (build-annotated1108 (lambda (src1876 exp1877) (if (and src1876 (not (annotation? exp1877))) (make-annotation exp1877 src1876 #t) exp1877))) (get-global-definition-hook1107 (lambda (symbol1878 module1879) (let ((module1880 (if module1879 (resolve-module (cdr module1879)) (let ((mod1881 (current-module))) (begin (if mod1881 (warn "wha" symbol1878)) mod1881))))) (let ((v1882 (module-variable module1880 symbol1878))) (and v1882 (object-property v1882 (quote *sc-expander*))))))) (remove-global-definition-hook1106 (lambda (symbol1883) (let ((module1884 (current-module))) (let ((v1885 (module-local-variable module1884 symbol1883))) (if v1885 (let ((p1886 (assq (quote *sc-expander*) (object-properties v1885)))) (set-object-properties! v1885 (delq p1886 (object-properties v1885))))))))) (put-global-definition-hook1105 (lambda (symbol1887 binding1888) (let ((module1889 (current-module))) (let ((v1890 (or (module-variable module1889 symbol1887) (let ((v1891 (make-variable (gensym)))) (begin (module-add! module1889 symbol1887 v1891) v1891))))) (begin (if (not (variable-bound? v1890)) (variable-set! v1890 (gensym))) (set-object-property! v1890 (quote *sc-expander*) binding1888)))))) (error-hook1104 (lambda (who1892 why1893 what1894) (error who1892 "~a ~s" why1893 what1894))) (local-eval-hook1103 (lambda (x1895 mod1896) (primitive-eval (list noexpand1097 x1895)))) (top-level-eval-hook1102 (lambda (x1897 mod1898) (primitive-eval (list noexpand1097 x1897)))) (fx<1101 <) (fx=1100 =) (fx-1099 -) (fx+1098 +) (noexpand1097 "noexpand")) (begin (global-extend1129 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1129 (quote local-syntax) (quote let-syntax) #f) (global-extend1129 (quote core) (quote fluid-let-syntax) (lambda (e1899 r1900 w1901 s1902 mod1903) ((lambda (tmp1904) ((lambda (tmp1905) (if (if tmp1905 (apply (lambda (_1906 var1907 val1908 e11909 e21910) (valid-bound-ids?1156 var1907)) tmp1905) #f) (apply (lambda (_1912 var1913 val1914 e11915 e21916) (let ((names1917 (map (lambda (x1918) (id-var-name1153 x1918 w1901)) var1913))) (begin (for-each (lambda (id1920 n1921) (let ((t1922 (binding-type1123 (lookup1128 n1921 r1900 mod1903)))) (if (memv t1922 (quote (displaced-lexical))) (syntax-error (source-wrap1160 id1920 w1901 s1902 mod1903) "identifier out of context")))) var1913 names1917) (chi-body1171 (cons e11915 e21916) (source-wrap1160 e1899 w1901 s1902 mod1903) (extend-env1125 names1917 (let ((trans-r1925 (macros-only-env1127 r1900))) (map (lambda (x1926) (cons (quote macro) (eval-local-transformer1174 (chi1167 x1926 trans-r1925 w1901 mod1903) mod1903))) val1914)) r1900) w1901 mod1903)))) tmp1905) ((lambda (_1928) (syntax-error (source-wrap1160 e1899 w1901 s1902 mod1903))) tmp1904))) (syntax-dispatch tmp1904 (quote (any #(each (any any)) any . each-any))))) e1899))) (global-extend1129 (quote core) (quote quote) (lambda (e1929 r1930 w1931 s1932 mod1933) ((lambda (tmp1934) ((lambda (tmp1935) (if tmp1935 (apply (lambda (_1936 e1937) (build-data1109 s1932 (strip1178 e1937 w1931))) tmp1935) ((lambda (_1938) (syntax-error (source-wrap1160 e1929 w1931 s1932 mod1933))) tmp1934))) (syntax-dispatch tmp1934 (quote (any any))))) e1929))) (global-extend1129 (quote core) (quote syntax) (letrec ((regen1946 (lambda (x1947) (let ((t1948 (car x1947))) (if (memv t1948 (quote (ref))) (build-annotated1108 #f (cadr x1947)) (if (memv t1948 (quote (primitive))) (build-annotated1108 #f (cadr x1947)) (if (memv t1948 (quote (quote))) (build-data1109 #f (cadr x1947)) (if (memv t1948 (quote (lambda))) (build-annotated1108 #f (list (quote lambda) (cadr x1947) (regen1946 (caddr x1947)))) (if (memv t1948 (quote (map))) (let ((ls1949 (map regen1946 (cdr x1947)))) (build-annotated1108 #f (cons (if (fx=1100 (length ls1949) 2) (build-annotated1108 #f (quote map)) (build-annotated1108 #f (quote map))) ls1949))) (build-annotated1108 #f (cons (build-annotated1108 #f (car x1947)) (map regen1946 (cdr x1947)))))))))))) (gen-vector1945 (lambda (x1950) (cond ((eq? (car x1950) (quote list)) (cons (quote vector) (cdr x1950))) ((eq? (car x1950) (quote quote)) (list (quote quote) (list->vector (cadr x1950)))) (else (list (quote list->vector) x1950))))) (gen-append1944 (lambda (x1951 y1952) (if (equal? y1952 (quote (quote ()))) x1951 (list (quote append) x1951 y1952)))) (gen-cons1943 (lambda (x1953 y1954) (let ((t1955 (car y1954))) (if (memv t1955 (quote (quote))) (if (eq? (car x1953) (quote quote)) (list (quote quote) (cons (cadr x1953) (cadr y1954))) (if (eq? (cadr y1954) (quote ())) (list (quote list) x1953) (list (quote cons) x1953 y1954))) (if (memv t1955 (quote (list))) (cons (quote list) (cons x1953 (cdr y1954))) (list (quote cons) x1953 y1954)))))) (gen-map1942 (lambda (e1956 map-env1957) (let ((formals1958 (map cdr map-env1957)) (actuals1959 (map (lambda (x1960) (list (quote ref) (car x1960))) map-env1957))) (cond ((eq? (car e1956) (quote ref)) (car actuals1959)) ((andmap (lambda (x1961) (and (eq? (car x1961) (quote ref)) (memq (cadr x1961) formals1958))) (cdr e1956)) (cons (quote map) (cons (list (quote primitive) (car e1956)) (map (let ((r1962 (map cons formals1958 actuals1959))) (lambda (x1963) (cdr (assq (cadr x1963) r1962)))) (cdr e1956))))) (else (cons (quote map) (cons (list (quote lambda) formals1958 e1956) actuals1959))))))) (gen-mappend1941 (lambda (e1964 map-env1965) (list (quote apply) (quote (primitive append)) (gen-map1942 e1964 map-env1965)))) (gen-ref1940 (lambda (src1966 var1967 level1968 maps1969) (if (fx=1100 level1968 0) (values var1967 maps1969) (if (null? maps1969) (syntax-error src1966 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1940 src1966 var1967 (fx-1099 level1968 1) (cdr maps1969))) (lambda (outer-var1970 outer-maps1971) (let ((b1972 (assq outer-var1970 (car maps1969)))) (if b1972 (values (cdr b1972) maps1969) (let ((inner-var1973 (gen-var1179 (quote tmp)))) (values inner-var1973 (cons (cons (cons outer-var1970 inner-var1973) (car maps1969)) outer-maps1971))))))))))) (gen-syntax1939 (lambda (src1974 e1975 r1976 maps1977 ellipsis?1978 mod1979) (if (id?1131 e1975) (let ((label1980 (id-var-name1153 e1975 (quote (()))))) (let ((b1981 (lookup1128 label1980 r1976 mod1979))) (if (eq? (binding-type1123 b1981) (quote syntax)) (call-with-values (lambda () (let ((var.lev1982 (binding-value1124 b1981))) (gen-ref1940 src1974 (car var.lev1982) (cdr var.lev1982) maps1977))) (lambda (var1983 maps1984) (values (list (quote ref) var1983) maps1984))) (if (ellipsis?1978 e1975) (syntax-error src1974 "misplaced ellipsis in syntax form") (values (list (quote quote) e1975) maps1977))))) ((lambda (tmp1985) ((lambda (tmp1986) (if (if tmp1986 (apply (lambda (dots1987 e1988) (ellipsis?1978 dots1987)) tmp1986) #f) (apply (lambda (dots1989 e1990) (gen-syntax1939 src1974 e1990 r1976 maps1977 (lambda (x1991) #f) mod1979)) tmp1986) ((lambda (tmp1992) (if (if tmp1992 (apply (lambda (x1993 dots1994 y1995) (ellipsis?1978 dots1994)) tmp1992) #f) (apply (lambda (x1996 dots1997 y1998) (let f1999 ((y2000 y1998) (k2001 (lambda (maps2002) (call-with-values (lambda () (gen-syntax1939 src1974 x1996 r1976 (cons (quote ()) maps2002) ellipsis?1978 mod1979)) (lambda (x2003 maps2004) (if (null? (car maps2004)) (syntax-error src1974 "extra ellipsis in syntax form") (values (gen-map1942 x2003 (car maps2004)) (cdr maps2004)))))))) ((lambda (tmp2005) ((lambda (tmp2006) (if (if tmp2006 (apply (lambda (dots2007 y2008) (ellipsis?1978 dots2007)) tmp2006) #f) (apply (lambda (dots2009 y2010) (f1999 y2010 (lambda (maps2011) (call-with-values (lambda () (k2001 (cons (quote ()) maps2011))) (lambda (x2012 maps2013) (if (null? (car maps2013)) (syntax-error src1974 "extra ellipsis in syntax form") (values (gen-mappend1941 x2012 (car maps2013)) (cdr maps2013)))))))) tmp2006) ((lambda (_2014) (call-with-values (lambda () (gen-syntax1939 src1974 y2000 r1976 maps1977 ellipsis?1978 mod1979)) (lambda (y2015 maps2016) (call-with-values (lambda () (k2001 maps2016)) (lambda (x2017 maps2018) (values (gen-append1944 x2017 y2015) maps2018)))))) tmp2005))) (syntax-dispatch tmp2005 (quote (any . any))))) y2000))) tmp1992) ((lambda (tmp2019) (if tmp2019 (apply (lambda (x2020 y2021) (call-with-values (lambda () (gen-syntax1939 src1974 x2020 r1976 maps1977 ellipsis?1978 mod1979)) (lambda (x2022 maps2023) (call-with-values (lambda () (gen-syntax1939 src1974 y2021 r1976 maps2023 ellipsis?1978 mod1979)) (lambda (y2024 maps2025) (values (gen-cons1943 x2022 y2024) maps2025)))))) tmp2019) ((lambda (tmp2026) (if tmp2026 (apply (lambda (e12027 e22028) (call-with-values (lambda () (gen-syntax1939 src1974 (cons e12027 e22028) r1976 maps1977 ellipsis?1978 mod1979)) (lambda (e2030 maps2031) (values (gen-vector1945 e2030) maps2031)))) tmp2026) ((lambda (_2032) (values (list (quote quote) e1975) maps1977)) tmp1985))) (syntax-dispatch tmp1985 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1985 (quote (any . any)))))) (syntax-dispatch tmp1985 (quote (any any . any)))))) (syntax-dispatch tmp1985 (quote (any any))))) e1975))))) (lambda (e2033 r2034 w2035 s2036 mod2037) (let ((e2038 (source-wrap1160 e2033 w2035 s2036 mod2037))) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda (_2041 x2042) (call-with-values (lambda () (gen-syntax1939 e2038 x2042 r2034 (quote ()) ellipsis?1176 mod2037)) (lambda (e2043 maps2044) (regen1946 e2043)))) tmp2040) ((lambda (_2045) (syntax-error e2038)) tmp2039))) (syntax-dispatch tmp2039 (quote (any any))))) e2038))))) (global-extend1129 (quote core) (quote lambda) (lambda (e2046 r2047 w2048 s2049 mod2050) ((lambda (tmp2051) ((lambda (tmp2052) (if tmp2052 (apply (lambda (_2053 c2054) (chi-lambda-clause1172 (source-wrap1160 e2046 w2048 s2049 mod2050) c2054 r2047 w2048 mod2050 (lambda (vars2055 body2056) (build-annotated1108 s2049 (list (quote lambda) vars2055 body2056))))) tmp2052) (syntax-error tmp2051))) (syntax-dispatch tmp2051 (quote (any . any))))) e2046))) (global-extend1129 (quote core) (quote let) (letrec ((chi-let2057 (lambda (e2058 r2059 w2060 s2061 mod2062 constructor2063 ids2064 vals2065 exps2066) (if (not (valid-bound-ids?1156 ids2064)) (syntax-error e2058 "duplicate bound variable in") (let ((labels2067 (gen-labels1137 ids2064)) (new-vars2068 (map gen-var1179 ids2064))) (let ((nw2069 (make-binding-wrap1148 ids2064 labels2067 w2060)) (nr2070 (extend-var-env1126 labels2067 new-vars2068 r2059))) (constructor2063 s2061 new-vars2068 (map (lambda (x2071) (chi1167 x2071 r2059 w2060 mod2062)) vals2065) (chi-body1171 exps2066 (source-wrap1160 e2058 nw2069 s2061 mod2062) nr2070 nw2069 mod2062)))))))) (lambda (e2072 r2073 w2074 s2075 mod2076) ((lambda (tmp2077) ((lambda (tmp2078) (if tmp2078 (apply (lambda (_2079 id2080 val2081 e12082 e22083) (chi-let2057 e2072 r2073 w2074 s2075 mod2076 build-let1111 id2080 val2081 (cons e12082 e22083))) tmp2078) ((lambda (tmp2087) (if (if tmp2087 (apply (lambda (_2088 f2089 id2090 val2091 e12092 e22093) (id?1131 f2089)) tmp2087) #f) (apply (lambda (_2094 f2095 id2096 val2097 e12098 e22099) (chi-let2057 e2072 r2073 w2074 s2075 mod2076 build-named-let1112 (cons f2095 id2096) val2097 (cons e12098 e22099))) tmp2087) ((lambda (_2103) (syntax-error (source-wrap1160 e2072 w2074 s2075 mod2076))) tmp2077))) (syntax-dispatch tmp2077 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2077 (quote (any #(each (any any)) any . each-any))))) e2072)))) (global-extend1129 (quote core) (quote letrec) (lambda (e2104 r2105 w2106 s2107 mod2108) ((lambda (tmp2109) ((lambda (tmp2110) (if tmp2110 (apply (lambda (_2111 id2112 val2113 e12114 e22115) (let ((ids2116 id2112)) (if (not (valid-bound-ids?1156 ids2116)) (syntax-error e2104 "duplicate bound variable in") (let ((labels2118 (gen-labels1137 ids2116)) (new-vars2119 (map gen-var1179 ids2116))) (let ((w2120 (make-binding-wrap1148 ids2116 labels2118 w2106)) (r2121 (extend-var-env1126 labels2118 new-vars2119 r2105))) (build-letrec1113 s2107 new-vars2119 (map (lambda (x2122) (chi1167 x2122 r2121 w2120 mod2108)) val2113) (chi-body1171 (cons e12114 e22115) (source-wrap1160 e2104 w2120 s2107 mod2108) r2121 w2120 mod2108))))))) tmp2110) ((lambda (_2125) (syntax-error (source-wrap1160 e2104 w2106 s2107 mod2108))) tmp2109))) (syntax-dispatch tmp2109 (quote (any #(each (any any)) any . each-any))))) e2104))) (global-extend1129 (quote core) (quote set!) (lambda (e2126 r2127 w2128 s2129 mod2130) ((lambda (tmp2131) ((lambda (tmp2132) (if (if tmp2132 (apply (lambda (_2133 id2134 val2135) (id?1131 id2134)) tmp2132) #f) (apply (lambda (_2136 id2137 val2138) (let ((val2139 (chi1167 val2138 r2127 w2128 mod2130)) (n2140 (id-var-name1153 id2137 w2128))) (let ((b2141 (lookup1128 n2140 r2127 mod2130))) (let ((t2142 (binding-type1123 b2141))) (if (memv t2142 (quote (lexical))) (build-annotated1108 s2129 (list (quote set!) (binding-value1124 b2141) val2139)) (if (memv t2142 (quote (global))) (build-annotated1108 s2129 (list (quote set!) (if mod2130 (make-module-ref (cdr mod2130) n2140 (car mod2130)) (make-module-ref mod2130 n2140 (quote bare))) val2139)) (if (memv t2142 (quote (displaced-lexical))) (syntax-error (wrap1159 id2137 w2128 mod2130) "identifier out of context") (syntax-error (source-wrap1160 e2126 w2128 s2129 mod2130))))))))) tmp2132) ((lambda (tmp2143) (if tmp2143 (apply (lambda (_2144 head2145 tail2146 val2147) (call-with-values (lambda () (syntax-type1165 head2145 r2127 (quote (())) #f #f mod2130)) (lambda (type2148 value2149 ee2150 ww2151 ss2152 modmod2153) (let ((t2154 type2148)) (if (memv t2154 (quote (module-ref))) (let ((val2155 (chi1167 val2147 r2127 w2128 mod2130))) (call-with-values (lambda () (value2149 (cons head2145 tail2146))) (lambda (id2157 mod2158) (build-annotated1108 s2129 (list (quote set!) (if mod2158 (make-module-ref (cdr mod2158) id2157 (car mod2158)) (make-module-ref mod2158 id2157 (quote bare))) val2155))))) (build-annotated1108 s2129 (cons (chi1167 (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2145) r2127 w2128 mod2130) (map (lambda (e2159) (chi1167 e2159 r2127 w2128 mod2130)) (append tail2146 (list val2147)))))))))) tmp2143) ((lambda (_2161) (syntax-error (source-wrap1160 e2126 w2128 s2129 mod2130))) tmp2131))) (syntax-dispatch tmp2131 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2131 (quote (any any any))))) e2126))) (global-extend1129 (quote module-ref) (quote @) (lambda (e2162) ((lambda (tmp2163) ((lambda (tmp2164) (if (if tmp2164 (apply (lambda (_2165 mod2166 id2167) (and (andmap id?1131 mod2166) (id?1131 id2167))) tmp2164) #f) (apply (lambda (_2169 mod2170 id2171) (values (syntax-object->datum id2171) (syntax-object->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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2170)))) tmp2164) (syntax-error tmp2163))) (syntax-dispatch tmp2163 (quote (any each-any any))))) e2162))) (global-extend1129 (quote module-ref) (quote @@) (lambda (e2173) ((lambda (tmp2174) ((lambda (tmp2175) (if (if tmp2175 (apply (lambda (_2176 mod2177 id2178) (and (andmap id?1131 mod2177) (id?1131 id2178))) tmp2175) #f) (apply (lambda (_2180 mod2181 id2182) (values (syntax-object->datum id2182) (syntax-object->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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2181)))) tmp2175) (syntax-error tmp2174))) (syntax-dispatch tmp2174 (quote (any each-any any))))) e2173))) (global-extend1129 (quote begin) (quote begin) (quote ())) (global-extend1129 (quote define) (quote define) (quote ())) (global-extend1129 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1129 (quote eval-when) (quote eval-when) (quote ())) (global-extend1129 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2187 (lambda (x2188 keys2189 clauses2190 r2191 mod2192) (if (null? clauses2190) (build-annotated1108 #f (list (build-annotated1108 #f (quote syntax-error)) x2188)) ((lambda (tmp2193) ((lambda (tmp2194) (if tmp2194 (apply (lambda (pat2195 exp2196) (if (and (id?1131 pat2195) (andmap (lambda (x2197) (not (free-id=?1154 pat2195 x2197))) (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 remove-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) (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" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2189))) (let ((labels2198 (list (gen-label1136))) (var2199 (gen-var1179 pat2195))) (build-annotated1108 #f (list (build-annotated1108 #f (list (quote lambda) (list var2199) (chi1167 exp2196 (extend-env1125 labels2198 (list (cons (quote syntax) (cons var2199 0))) r2191) (make-binding-wrap1148 (list pat2195) labels2198 (quote (()))) mod2192))) x2188))) (gen-clause2186 x2188 keys2189 (cdr clauses2190) r2191 pat2195 #t exp2196 mod2192))) tmp2194) ((lambda (tmp2200) (if tmp2200 (apply (lambda (pat2201 fender2202 exp2203) (gen-clause2186 x2188 keys2189 (cdr clauses2190) r2191 pat2201 fender2202 exp2203 mod2192)) tmp2200) ((lambda (_2204) (syntax-error (car clauses2190) "invalid syntax-case clause")) tmp2193))) (syntax-dispatch tmp2193 (quote (any any any)))))) (syntax-dispatch tmp2193 (quote (any any))))) (car clauses2190))))) (gen-clause2186 (lambda (x2205 keys2206 clauses2207 r2208 pat2209 fender2210 exp2211 mod2212) (call-with-values (lambda () (convert-pattern2184 pat2209 keys2206)) (lambda (p2213 pvars2214) (cond ((not (distinct-bound-ids?1157 (map car pvars2214))) (syntax-error pat2209 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2215) (not (ellipsis?1176 (car x2215)))) pvars2214)) (syntax-error pat2209 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2216 (gen-var1179 (quote tmp)))) (build-annotated1108 #f (list (build-annotated1108 #f (list (quote lambda) (list y2216) (let ((y2217 (build-annotated1108 #f y2216))) (build-annotated1108 #f (list (quote if) ((lambda (tmp2218) ((lambda (tmp2219) (if tmp2219 (apply (lambda () y2217) tmp2219) ((lambda (_2220) (build-annotated1108 #f (list (quote if) y2217 (build-dispatch-call2185 pvars2214 fender2210 y2217 r2208 mod2212) (build-data1109 #f #f)))) tmp2218))) (syntax-dispatch tmp2218 (quote #(atom #t))))) fender2210) (build-dispatch-call2185 pvars2214 exp2211 y2217 r2208 mod2212) (gen-syntax-case2187 x2205 keys2206 clauses2207 r2208 mod2212)))))) (if (eq? p2213 (quote any)) (build-annotated1108 #f (list (build-annotated1108 #f (quote list)) x2205)) (build-annotated1108 #f (list (build-annotated1108 #f (quote syntax-dispatch)) x2205 (build-data1109 #f p2213))))))))))))) (build-dispatch-call2185 (lambda (pvars2221 exp2222 y2223 r2224 mod2225) (let ((ids2226 (map car pvars2221)) (levels2227 (map cdr pvars2221))) (let ((labels2228 (gen-labels1137 ids2226)) (new-vars2229 (map gen-var1179 ids2226))) (build-annotated1108 #f (list (build-annotated1108 #f (quote apply)) (build-annotated1108 #f (list (quote lambda) new-vars2229 (chi1167 exp2222 (extend-env1125 labels2228 (map (lambda (var2230 level2231) (cons (quote syntax) (cons var2230 level2231))) new-vars2229 (map cdr pvars2221)) r2224) (make-binding-wrap1148 ids2226 labels2228 (quote (()))) mod2225))) y2223)))))) (convert-pattern2184 (lambda (pattern2232 keys2233) (let cvt2234 ((p2235 pattern2232) (n2236 0) (ids2237 (quote ()))) (if (id?1131 p2235) (if (bound-id-member?1158 p2235 keys2233) (values (vector (quote free-id) p2235) ids2237) (values (quote any) (cons (cons p2235 n2236) ids2237))) ((lambda (tmp2238) ((lambda (tmp2239) (if (if tmp2239 (apply (lambda (x2240 dots2241) (ellipsis?1176 dots2241)) tmp2239) #f) (apply (lambda (x2242 dots2243) (call-with-values (lambda () (cvt2234 x2242 (fx+1098 n2236 1) ids2237)) (lambda (p2244 ids2245) (values (if (eq? p2244 (quote any)) (quote each-any) (vector (quote each) p2244)) ids2245)))) tmp2239) ((lambda (tmp2246) (if tmp2246 (apply (lambda (x2247 y2248) (call-with-values (lambda () (cvt2234 y2248 n2236 ids2237)) (lambda (y2249 ids2250) (call-with-values (lambda () (cvt2234 x2247 n2236 ids2250)) (lambda (x2251 ids2252) (values (cons x2251 y2249) ids2252)))))) tmp2246) ((lambda (tmp2253) (if tmp2253 (apply (lambda () (values (quote ()) ids2237)) tmp2253) ((lambda (tmp2254) (if tmp2254 (apply (lambda (x2255) (call-with-values (lambda () (cvt2234 x2255 n2236 ids2237)) (lambda (p2257 ids2258) (values (vector (quote vector) p2257) ids2258)))) tmp2254) ((lambda (x2259) (values (vector (quote atom) (strip1178 p2235 (quote (())))) ids2237)) tmp2238))) (syntax-dispatch tmp2238 (quote #(vector each-any)))))) (syntax-dispatch tmp2238 (quote ()))))) (syntax-dispatch tmp2238 (quote (any . any)))))) (syntax-dispatch tmp2238 (quote (any any))))) p2235)))))) (lambda (e2260 r2261 w2262 s2263 mod2264) (let ((e2265 (source-wrap1160 e2260 w2262 s2263 mod2264))) ((lambda (tmp2266) ((lambda (tmp2267) (if tmp2267 (apply (lambda (_2268 val2269 key2270 m2271) (if (andmap (lambda (x2272) (and (id?1131 x2272) (not (ellipsis?1176 x2272)))) key2270) (let ((x2274 (gen-var1179 (quote tmp)))) (build-annotated1108 s2263 (list (build-annotated1108 #f (list (quote lambda) (list x2274) (gen-syntax-case2187 (build-annotated1108 #f x2274) key2270 m2271 r2261 mod2264))) (chi1167 val2269 r2261 (quote (())) mod2264)))) (syntax-error e2265 "invalid literals list in"))) tmp2267) (syntax-error tmp2266))) (syntax-dispatch tmp2266 (quote (any any each-any . each-any))))) e2265))))) (set! sc-expand (let ((m2277 (quote e)) (esew2278 (quote (eval)))) (lambda (x2279) (if (and (pair? x2279) (equal? (car x2279) noexpand1097)) (cadr x2279) (chi-top1166 x2279 (quote ()) (quote ((top))) m2277 esew2278 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2280 (quote e)) (esew2281 (quote (eval)))) (lambda (x2283 . rest2282) (if (and (pair? x2283) (equal? (car x2283) noexpand1097)) (cadr x2283) (chi-top1166 x2283 (quote ()) (quote ((top))) (if (null? rest2282) m2280 (car rest2282)) (if (or (null? rest2282) (null? (cdr rest2282))) esew2281 (cadr rest2282)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2284) (nonsymbol-id?1130 x2284))) (set! datum->syntax-object (lambda (id2285 datum2286) (make-syntax-object1114 datum2286 (syntax-object-wrap1117 id2285) #f))) (set! syntax-object->datum (lambda (x2287) (strip1178 x2287 (quote (()))))) (set! generate-temporaries (lambda (ls2288) (begin (let ((x2289 ls2288)) (if (not (list? x2289)) (error-hook1104 (quote generate-temporaries) "invalid argument" x2289))) (map (lambda (x2290) (wrap1159 (gensym) (quote ((top))) #f)) ls2288)))) (set! free-identifier=? (lambda (x2291 y2292) (begin (let ((x2293 x2291)) (if (not (nonsymbol-id?1130 x2293)) (error-hook1104 (quote free-identifier=?) "invalid argument" x2293))) (let ((x2294 y2292)) (if (not (nonsymbol-id?1130 x2294)) (error-hook1104 (quote free-identifier=?) "invalid argument" x2294))) (free-id=?1154 x2291 y2292)))) (set! bound-identifier=? (lambda (x2295 y2296) (begin (let ((x2297 x2295)) (if (not (nonsymbol-id?1130 x2297)) (error-hook1104 (quote bound-identifier=?) "invalid argument" x2297))) (let ((x2298 y2296)) (if (not (nonsymbol-id?1130 x2298)) (error-hook1104 (quote bound-identifier=?) "invalid argument" x2298))) (bound-id=?1155 x2295 y2296)))) (set! syntax-error (lambda (object2300 . messages2299) (begin (for-each (lambda (x2301) (let ((x2302 x2301)) (if (not (string? x2302)) (error-hook1104 (quote syntax-error) "invalid argument" x2302)))) messages2299) (let ((message2303 (if (null? messages2299) "invalid syntax" (apply string-append messages2299)))) (error-hook1104 #f message2303 (strip1178 object2300 (quote (())))))))) (set! install-global-transformer (lambda (sym2304 v2305) (begin (let ((x2306 sym2304)) (if (not (symbol? x2306)) (error-hook1104 (quote define-syntax) "invalid argument" x2306))) (let ((x2307 v2305)) (if (not (procedure? x2307)) (error-hook1104 (quote define-syntax) "invalid argument" x2307))) (global-extend1129 (quote macro) sym2304 v2305)))) (letrec ((match2312 (lambda (e2313 p2314 w2315 r2316 mod2317) (cond ((not r2316) #f) ((eq? p2314 (quote any)) (cons (wrap1159 e2313 w2315 mod2317) r2316)) ((syntax-object?1115 e2313) (match*2311 (let ((e2318 (syntax-object-expression1116 e2313))) (if (annotation? e2318) (annotation-expression e2318) e2318)) p2314 (join-wraps1150 w2315 (syntax-object-wrap1117 e2313)) r2316 (syntax-object-module1118 e2313))) (else (match*2311 (let ((e2319 e2313)) (if (annotation? e2319) (annotation-expression e2319) e2319)) p2314 w2315 r2316 mod2317))))) (match*2311 (lambda (e2320 p2321 w2322 r2323 mod2324) (cond ((null? p2321) (and (null? e2320) r2323)) ((pair? p2321) (and (pair? e2320) (match2312 (car e2320) (car p2321) w2322 (match2312 (cdr e2320) (cdr p2321) w2322 r2323 mod2324) mod2324))) ((eq? p2321 (quote each-any)) (let ((l2325 (match-each-any2309 e2320 w2322 mod2324))) (and l2325 (cons l2325 r2323)))) (else (let ((t2326 (vector-ref p2321 0))) (if (memv t2326 (quote (each))) (if (null? e2320) (match-empty2310 (vector-ref p2321 1) r2323) (let ((l2327 (match-each2308 e2320 (vector-ref p2321 1) w2322 mod2324))) (and l2327 (let collect2328 ((l2329 l2327)) (if (null? (car l2329)) r2323 (cons (map car l2329) (collect2328 (map cdr l2329)))))))) (if (memv t2326 (quote (free-id))) (and (id?1131 e2320) (free-id=?1154 (wrap1159 e2320 w2322 mod2324) (vector-ref p2321 1)) r2323) (if (memv t2326 (quote (atom))) (and (equal? (vector-ref p2321 1) (strip1178 e2320 w2322)) r2323) (if (memv t2326 (quote (vector))) (and (vector? e2320) (match2312 (vector->list e2320) (vector-ref p2321 1) w2322 r2323 mod2324))))))))))) (match-empty2310 (lambda (p2330 r2331) (cond ((null? p2330) r2331) ((eq? p2330 (quote any)) (cons (quote ()) r2331)) ((pair? p2330) (match-empty2310 (car p2330) (match-empty2310 (cdr p2330) r2331))) ((eq? p2330 (quote each-any)) (cons (quote ()) r2331)) (else (let ((t2332 (vector-ref p2330 0))) (if (memv t2332 (quote (each))) (match-empty2310 (vector-ref p2330 1) r2331) (if (memv t2332 (quote (free-id atom))) r2331 (if (memv t2332 (quote (vector))) (match-empty2310 (vector-ref p2330 1) r2331))))))))) (match-each-any2309 (lambda (e2333 w2334 mod2335) (cond ((annotation? e2333) (match-each-any2309 (annotation-expression e2333) w2334 mod2335)) ((pair? e2333) (let ((l2336 (match-each-any2309 (cdr e2333) w2334 mod2335))) (and l2336 (cons (wrap1159 (car e2333) w2334 mod2335) l2336)))) ((null? e2333) (quote ())) ((syntax-object?1115 e2333) (match-each-any2309 (syntax-object-expression1116 e2333) (join-wraps1150 w2334 (syntax-object-wrap1117 e2333)) mod2335)) (else #f)))) (match-each2308 (lambda (e2337 p2338 w2339 mod2340) (cond ((annotation? e2337) (match-each2308 (annotation-expression e2337) p2338 w2339 mod2340)) ((pair? e2337) (let ((first2341 (match2312 (car e2337) p2338 w2339 (quote ()) mod2340))) (and first2341 (let ((rest2342 (match-each2308 (cdr e2337) p2338 w2339 mod2340))) (and rest2342 (cons first2341 rest2342)))))) ((null? e2337) (quote ())) ((syntax-object?1115 e2337) (match-each2308 (syntax-object-expression1116 e2337) p2338 (join-wraps1150 w2339 (syntax-object-wrap1117 e2337)) (syntax-object-module1118 e2337))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2343 p2344) (cond ((eq? p2344 (quote any)) (list e2343)) ((syntax-object?1115 e2343) (match*2311 (let ((e2345 (syntax-object-expression1116 e2343))) (if (annotation? e2345) (annotation-expression e2345) e2345)) p2344 (syntax-object-wrap1117 e2343) (quote ()) (syntax-object-module1118 e2343))) (else (match*2311 (let ((e2346 e2343)) (if (annotation? e2346) (annotation-expression e2346) e2346)) p2344 (quote (())) (quote ()) #f))))) (set! sc-chi chi1167))))) (install-global-transformer (quote with-syntax) (lambda (x2347) ((lambda (tmp2348) ((lambda (tmp2349) (if tmp2349 (apply (lambda (_2350 e12351 e22352) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12351 e22352))) tmp2349) ((lambda (tmp2354) (if tmp2354 (apply (lambda (_2355 out2356 in2357 e12358 e22359) (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))) in2357 (quote ()) (list out2356 (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 e12358 e22359))))) tmp2354) ((lambda (tmp2361) (if tmp2361 (apply (lambda (_2362 out2363 in2364 e12365 e22366) (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))) in2364) (quote ()) (list out2363 (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 e12365 e22366))))) tmp2361) (syntax-error tmp2348))) (syntax-dispatch tmp2348 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2348 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2348 (quote (any () any . each-any))))) x2347))) (install-global-transformer (quote syntax-rules) (lambda (x2370) ((lambda (tmp2371) ((lambda (tmp2372) (if tmp2372 (apply (lambda (_2373 k2374 keyword2375 pattern2376 template2377) (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 k2374 (map (lambda (tmp2380 tmp2379) (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))) tmp2379) (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))) tmp2380))) template2377 pattern2376)))))) tmp2372) (syntax-error tmp2371))) (syntax-dispatch tmp2371 (quote (any each-any . #(each ((any . any) any))))))) x2370))) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index e6eaf9384..a5ea0ac60 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -256,6 +256,9 @@ +(eval-when (compile) + (set-current-module (resolve-module '(guile)))) + (let () (define-syntax define-structure (lambda (x) diff --git a/module/ice-9/r4rs.scm b/module/ice-9/r4rs.scm index 875229f6a..7b1c11cc1 100644 --- a/module/ice-9/r4rs.scm +++ b/module/ice-9/r4rs.scm @@ -17,6 +17,9 @@ ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +(eval-when (compile) + (set-current-module (resolve-module '(guile)))) + ;;;; apply and call-with-current-continuation