From 7bfedb87078d3119913e51511ba35e2fbc6f6d5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 15 Feb 2011 16:45:20 +0100 Subject: [PATCH 001/183] Switch to 2.0.0. * GUILE-VERSION (GUILE_MAJOR_VERSION, GUILE_MINOR_VERSION, GUILE_MINOR_VERSION): 2.0.0! --- GUILE-VERSION | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GUILE-VERSION b/GUILE-VERSION index 35352ca6f..7da933738 100644 --- a/GUILE-VERSION +++ b/GUILE-VERSION @@ -1,9 +1,9 @@ # -*-shell-script-*- # Note: `GUILE_VERSION' is defined in `configure.ac' using `git-version-gen'. -GUILE_MAJOR_VERSION=1 -GUILE_MINOR_VERSION=9 -GUILE_MICRO_VERSION=15 +GUILE_MAJOR_VERSION=2 +GUILE_MINOR_VERSION=0 +GUILE_MICRO_VERSION=0 GUILE_EFFECTIVE_VERSION=2.0 From c05696aa940c276ce6ee4ceeb853e562898c190a Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 14 Feb 2011 18:18:52 -0500 Subject: [PATCH 002/183] Fix comment above number-theoretic division tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * test-suite/tests/numbers.test: Fix comment. Signed-off-by: Ludovic Courtès --- test-suite/tests/numbers.test | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 1f2ee035d..9e9728fb0 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -4511,13 +4511,27 @@ (eqv-loosely? +7.071-7.071i (sqrt -100.0i)))) +;;; +;;; Tests for number-theoretic division operators: ;;; ;;; euclidean/ ;;; euclidean-quotient ;;; euclidean-remainder +;;; floor/ +;;; floor-quotient +;;; floor-remainder +;;; ceiling/ +;;; ceiling-quotient +;;; ceiling-remainder +;;; truncate/ +;;; truncate-quotient +;;; truncate-remainder ;;; centered/ ;;; centered-quotient ;;; centered-remainder +;;; round/ +;;; round-quotient +;;; round-remainder ;;; (with-test-prefix "Number-theoretic division" From a5f6b751be7991134fc27c47510fc73038a25a5a Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 15 Feb 2011 10:37:03 -0500 Subject: [PATCH 003/183] Improvements to `log' and `log10' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * libguile/numbers.c (log_of_shifted_double, log_of_exact_integer, log_of_exact_integer_with_size, log_of_fraction): New internal static functions used by scm_log and scm_log10. (scm_log, scm_log10): Robustly handle large integers, large and small fractions, and fractions close to 1. Previously, computing logarithms of fractions close to 1 yielded grossly inaccurate results, and the other cases yielded infinities even though the answer could easily fit in a double. (log -0.0) now returns -inf.0+i, where previously it returned -inf.0. (log 0) now throws a numerical overflow exception, where previously it returned -inf.0. (log 0.0) still returns -inf.0. Analogous changes made to `log10'. * test-suite/tests/numbers.test (log, log10): Add tests. Signed-off-by: Ludovic Courtès --- libguile/numbers.c | 108 ++++++++++++++++++++++++++++------ test-suite/tests/numbers.test | 76 +++++++++++++++++++----- 2 files changed, 150 insertions(+), 34 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 7c4ea1b50..d0aacb7c4 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -111,6 +111,7 @@ typedef scm_t_signed_bits scm_t_inum; static SCM flo0; static SCM exactly_one_half; +static SCM flo_log10e; #define SCM_SWAP(x, y) do { SCM __t = x; x = y; y = __t; } while (0) @@ -9372,6 +9373,62 @@ scm_is_number (SCM z) } +/* Returns log(x * 2^shift) */ +static SCM +log_of_shifted_double (double x, long shift) +{ + double ans = log (fabs (x)) + shift * M_LN2; + + if (x > 0.0 || double_is_non_negative_zero (x)) + return scm_from_double (ans); + else + return scm_c_make_rectangular (ans, M_PI); +} + +/* Returns log(n), for exact integer n of integer-length size */ +static SCM +log_of_exact_integer_with_size (SCM n, long size) +{ + long shift = size - 2 * scm_dblprec[0]; + + if (shift > 0) + return log_of_shifted_double + (scm_to_double (scm_ash (n, scm_from_long(-shift))), + shift); + else + return log_of_shifted_double (scm_to_double (n), 0); +} + +/* Returns log(n), for exact integer n of integer-length size */ +static SCM +log_of_exact_integer (SCM n) +{ + return log_of_exact_integer_with_size + (n, scm_to_long (scm_integer_length (n))); +} + +/* Returns log(n/d), for exact non-zero integers n and d */ +static SCM +log_of_fraction (SCM n, SCM d) +{ + long n_size = scm_to_long (scm_integer_length (n)); + long d_size = scm_to_long (scm_integer_length (d)); + + if (abs (n_size - d_size) > 1) + return (scm_difference (log_of_exact_integer_with_size (n, n_size), + log_of_exact_integer_with_size (d, d_size))); + else if (scm_is_false (scm_negative_p (n))) + return scm_from_double + (log1p (scm_to_double (scm_divide2real (scm_difference (n, d), d)))); + else + return scm_c_make_rectangular + (log1p (scm_to_double (scm_divide2real + (scm_difference (scm_abs (n), d), + d))), + M_PI); +} + + /* In the following functions we dispatch to the real-arg funcs like log() when we know the arg is real, instead of just handing everything to clog() for instance. This is in case clog() doesn't optimize for a @@ -9394,17 +9451,21 @@ SCM_PRIMITIVE_GENERIC (scm_log, "log", 1, 0, 0, atan2 (im, re)); #endif } - else if (SCM_NUMBERP (z)) + else if (SCM_REALP (z)) + return log_of_shifted_double (SCM_REAL_VALUE (z), 0); + else if (SCM_I_INUMP (z)) { - /* ENHANCE-ME: When z is a bignum the logarithm will fit a double - although the value itself overflows. */ - double re = scm_to_double (z); - double l = log (fabs (re)); - if (re >= 0.0) - return scm_from_double (l); - else - return scm_c_make_rectangular (l, M_PI); +#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO + if (scm_is_eq (z, SCM_INUM0)) + scm_num_overflow (s_scm_log); +#endif + return log_of_shifted_double (SCM_I_INUM (z), 0); } + else if (SCM_BIGP (z)) + return log_of_exact_integer (z); + else if (SCM_FRACTIONP (z)) + return log_of_fraction (SCM_FRACTION_NUMERATOR (z), + SCM_FRACTION_DENOMINATOR (z)); else SCM_WTA_DISPATCH_1 (g_scm_log, z, 1, s_scm_log); } @@ -9431,17 +9492,27 @@ SCM_PRIMITIVE_GENERIC (scm_log10, "log10", 1, 0, 0, M_LOG10E * atan2 (im, re)); #endif } - else if (SCM_NUMBERP (z)) + else if (SCM_REALP (z) || SCM_I_INUMP (z)) { - /* ENHANCE-ME: When z is a bignum the logarithm will fit a double - although the value itself overflows. */ - double re = scm_to_double (z); - double l = log10 (fabs (re)); - if (re >= 0.0) - return scm_from_double (l); - else - return scm_c_make_rectangular (l, M_LOG10E * M_PI); +#ifndef ALLOW_DIVIDE_BY_EXACT_ZERO + if (scm_is_eq (z, SCM_INUM0)) + scm_num_overflow (s_scm_log10); +#endif + { + double re = scm_to_double (z); + double l = log10 (fabs (re)); + if (re > 0.0 || double_is_non_negative_zero (re)) + return scm_from_double (l); + else + return scm_c_make_rectangular (l, M_LOG10E * M_PI); + } } + else if (SCM_BIGP (z)) + return scm_product (flo_log10e, log_of_exact_integer (z)); + else if (SCM_FRACTIONP (z)) + return scm_product (flo_log10e, + log_of_fraction (SCM_FRACTION_NUMERATOR (z), + SCM_FRACTION_DENOMINATOR (z))); else SCM_WTA_DISPATCH_1 (g_scm_log10, z, 1, s_scm_log10); } @@ -9536,6 +9607,7 @@ scm_init_numbers () scm_add_feature ("complex"); scm_add_feature ("inexact"); flo0 = scm_from_double (0.0); + flo_log10e = scm_from_double (M_LOG10E); /* determine floating point precision */ for (i=2; i <= SCM_MAX_DBL_RADIX; ++i) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 9e9728fb0..cb582ed1b 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -4323,14 +4323,36 @@ (log)) (pass-if-exception "two args" exception:wrong-num-args (log 123 456)) + (pass-if-exception "(log 0)" exception:numerical-overflow + (log 0)) - (pass-if (negative-infinity? (log 0))) - (pass-if (negative-infinity? (log 0.0))) - (pass-if (eqv? 0.0 (log 1))) - (pass-if (eqv? 0.0 (log 1.0))) - (pass-if (eqv-loosely? 1.0 (log const-e))) - (pass-if (eqv-loosely? 2.0 (log const-e^2))) - (pass-if (eqv-loosely? -1.0 (log const-1/e))) + (pass-if (test-eqv? -inf.0 (log 0.0))) + (pass-if (test-eqv? +inf.0 (log +inf.0))) + (pass-if (test-eqv? -inf.0+3.14159265358979i (log -0.0))) + (pass-if (test-eqv? +inf.0+3.14159265358979i (log -inf.0))) + (pass-if (test-eqv? 0.0 (log 1 ))) + (pass-if (test-eqv? 0.0 (log 1.0))) + (pass-if (test-eqv? 1.0 (log const-e))) + (pass-if (test-eqv? 2.0 (log const-e^2))) + (pass-if (test-eqv? -1.0 (log const-1/e))) + (pass-if (test-eqv? -1.0+3.14159265358979i (log (- const-1/e)))) + (pass-if (test-eqv? 2.30258509299405 (log 10))) + (pass-if (test-eqv? 2.30258509299405+3.14159265358979i (log -10))) + + (pass-if (test-eqv? 1.0+0.0i (log (+ const-e +0.0i)))) + (pass-if (test-eqv? 1.0-0.0i (log (+ const-e -0.0i)))) + + (pass-if (eqv-loosely? 230258.509299405 (log (expt 10 100000)))) + (pass-if (eqv-loosely? -230258.509299405 (log (expt 10 -100000)))) + (pass-if (eqv-loosely? 230257.410687116 (log (/ (expt 10 100000) 3)))) + (pass-if (eqv-loosely? 230258.509299405+3.14159265358979i + (log (- (expt 10 100000))))) + (pass-if (eqv-loosely? -230258.509299405+3.14159265358979i + (log (- (expt 10 -100000))))) + (pass-if (eqv-loosely? 230257.410687116+3.14159265358979i + (log (- (/ (expt 10 100000) 3))))) + (pass-if (test-eqv? 3.05493636349961e-151 + (log (/ (1+ (expt 2 500)) (expt 2 500))))) (pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i))) (pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i))) @@ -4350,20 +4372,42 @@ (log10)) (pass-if-exception "two args" exception:wrong-num-args (log10 123 456)) + (pass-if-exception "(log10 0)" exception:numerical-overflow + (log10 0)) - (pass-if (negative-infinity? (log10 0))) - (pass-if (negative-infinity? (log10 0.0))) - (pass-if (eqv? 0.0 (log10 1))) - (pass-if (eqv? 0.0 (log10 1.0))) - (pass-if (eqv-loosely? 1.0 (log10 10.0))) - (pass-if (eqv-loosely? 2.0 (log10 100.0))) - (pass-if (eqv-loosely? -1.0 (log10 0.1))) + (pass-if (test-eqv? -inf.0 (log10 0.0))) + (pass-if (test-eqv? +inf.0 (log10 +inf.0))) + (pass-if (test-eqv? -inf.0+1.36437635384184i (log10 -0.0))) + (pass-if (test-eqv? +inf.0+1.36437635384184i (log10 -inf.0))) + (pass-if (test-eqv? 0.0 (log10 1 ))) + (pass-if (test-eqv? 0.0 (log10 1.0))) + (pass-if (test-eqv? 1.0 (log10 10 ))) + (pass-if (test-eqv? 1.0 (log10 10.0))) + (pass-if (test-eqv? 2.0 (log10 100.0))) + (pass-if (test-eqv? -1.0 (log10 0.1))) + (pass-if (test-eqv? -1.0+1.36437635384184i (log10 -0.1))) + (pass-if (test-eqv? 1.0+1.36437635384184i (log10 -10 ))) + + (pass-if (test-eqv? 1.0+0.0i (log10 10.0+0.0i))) + (pass-if (test-eqv? 1.0-0.0i (log10 10.0-0.0i))) + + (pass-if (eqv-loosely? 100000.0 (log10 (expt 10 100000)))) + (pass-if (eqv-loosely? -100000.0 (log10 (expt 10 -100000)))) + (pass-if (eqv-loosely? 99999.5228787453 (log10 (/ (expt 10 100000) 3)))) + (pass-if (eqv-loosely? 100000.0+1.36437635384184i + (log10 (- (expt 10 100000))))) + (pass-if (eqv-loosely? -100000.0+1.36437635384184i + (log10 (- (expt 10 -100000))))) + (pass-if (eqv-loosely? 99999.5228787453+1.36437635384184i + (log10 (- (/ (expt 10 100000) 3))))) + (pass-if (test-eqv? 1.32674200523347e-151 + (log10 (/ (1+ (expt 2 500)) (expt 2 500))))) (pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i))) (pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i))) - (pass-if (eqv-loosely? 0.0+1.36437i (log10 -1))) - (pass-if (eqv-loosely? 1.0+1.36437i (log10 -10))) + (pass-if (eqv-loosely? 0.0+1.36437i (log10 -1))) + (pass-if (eqv-loosely? 1.0+1.36437i (log10 -10))) (pass-if (eqv-loosely? 2.0+1.36437i (log10 -100)))) ;;; From 958a28e9fec33ebb4673294308a82ccd18cc6071 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 16 Feb 2011 10:25:23 +0100 Subject: [PATCH 004/183] Change tag naming convention to `vX.Y.Z'. * configure.ac: Tell `git-version-gen' that we're switching to a `vX.Y.Z' scheme for release tags. --- configure.ac | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/configure.ac b/configure.ac index 5b47701b7..423ae9988 100644 --- a/configure.ac +++ b/configure.ac @@ -29,9 +29,7 @@ Floor, Boston, MA 02110-1301, USA. AC_PREREQ(2.61) AC_INIT([GNU Guile], - m4_esyscmd([build-aux/git-version-gen \ - .tarball-version \ - 's/^release_\([0-9][0-9]*\)-\([0-9][0-9]*\)-\([0-9][0-9]*\)/v\1.\2\.\3/g']), + m4_esyscmd([build-aux/git-version-gen .tarball-version]), [bug-guile@gnu.org]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) From 7e23d9d0f1efd8d62e8fbe1341d0e1ea54b2eb57 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 18 Feb 2011 09:38:04 +0100 Subject: [PATCH 005/183] update extension example in manual * doc/ref/libguile-extensions.texi (A Sample Guile Extension): Fix use of deprecated functions. --- doc/ref/libguile-extensions.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ref/libguile-extensions.texi b/doc/ref/libguile-extensions.texi index 78871c6ca..a5de72dd4 100644 --- a/doc/ref/libguile-extensions.texi +++ b/doc/ref/libguile-extensions.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -64,7 +64,7 @@ Consider the following file @file{bessel.c}. SCM j0_wrapper (SCM x) @{ - return scm_make_real (j0 (scm_num2dbl (x, "j0"))); + return scm_from_double (j0 (scm_to_double (x))); @} void From dd0d987fbdf32387ff4b36631302918ca8ff36cb Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 18 Feb 2011 15:52:02 +0100 Subject: [PATCH 006/183] add (ice-9 binary-ports) * module/ice-9/binary-ports.scm: New module. * module/Makefile.am: Add to makefile. * module/rnrs/io/ports.scm: Re-export bindings from (ice-9 binary ports). This will allow the compiler to not pull (rnrs) into its included module set. --- module/Makefile.am | 1 + module/ice-9/binary-ports.scm | 49 +++++++++++++++++++++++++++++++++++ module/rnrs/io/ports.scm | 9 +++---- 3 files changed, 54 insertions(+), 5 deletions(-) create mode 100644 module/ice-9/binary-ports.scm diff --git a/module/Makefile.am b/module/Makefile.am index 994090015..c0f68864f 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -180,6 +180,7 @@ ICE_9_SOURCES = \ ice-9/r5rs.scm \ ice-9/deprecated.scm \ ice-9/and-let-star.scm \ + ice-9/binary-ports.scm \ ice-9/calling.scm \ ice-9/common-list.scm \ ice-9/control.scm \ diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm new file mode 100644 index 000000000..63d09cf21 --- /dev/null +++ b/module/ice-9/binary-ports.scm @@ -0,0 +1,49 @@ +;;;; binary-ports.scm --- Binary IO on ports + +;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Author: Ludovic Courtès + +;;; Commentary: +;;; +;;; The I/O port API of the R6RS is provided by this module. In many areas +;;; it complements or refines Guile's own historical port API. For instance, +;;; it allows for binary I/O with bytevectors. +;;; +;;; Code: + +(define-module (ice-9 binary-ports) + #:use-module (rnrs bytevectors) + #:export (eof-object + open-bytevector-input-port + make-custom-binary-input-port + get-u8 + lookahead-u8 + get-bytevector-n + get-bytevector-n! + get-bytevector-some + get-bytevector-all + put-u8 + put-bytevector + open-bytevector-output-port + make-custom-binary-output-port)) + +;; Note that this extension also defines %make-transcoded-port, which is +;; not exported but is used by (rnrs io ports). + +(load-extension (string-append "libguile-" (effective-version)) + "scm_init_r6rs_ports") diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index a5815c85f..d3a81b7c7 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -98,7 +98,8 @@ make-i/o-decoding-error &i/o-encoding-error i/o-encoding-error? make-i/o-encoding-error i/o-encoding-error-char) - (import (only (rnrs base) assertion-violation) + (import (ice-9 binary-ports) + (only (rnrs base) assertion-violation) (rnrs enums) (rnrs records syntactic) (rnrs exceptions) @@ -108,9 +109,6 @@ (ice-9 rdelim) (except (guile) raise)) -(load-extension (string-append "libguile-" (effective-version)) - "scm_init_r6rs_ports") - ;;; @@ -205,7 +203,8 @@ "Return a new textual port based on @var{port}, using @var{transcoder} to encode and decode data written to or read from its underlying binary port @var{port}." - (let ((result (%make-transcoded-port port))) + ;; Hackily get at %make-transcoded-port. + (let ((result ((@@ (ice-9 binary-ports) %make-transcoded-port) port))) (set-port-encoding! result (transcoder-codec transcoder)) (case (transcoder-error-handling-mode transcoder) ((raise) From 6854c32480e95ca54e95da585e74002d8897573c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 18 Feb 2011 15:57:27 +0100 Subject: [PATCH 007/183] core modules use (ice-9 binary-ports) instead of (rnrs io ports) * module/language/assembly/compile-bytecode.scm: * module/language/elisp/lexer.scm: * module/web/request.scm: * module/web/response.scm: * module/web/server.scm: * module/web/uri.scm: Use ice-9 binary-ports. --- module/language/assembly/compile-bytecode.scm | 6 +++++- module/language/elisp/lexer.scm | 2 +- module/web/request.scm | 2 +- module/web/response.scm | 2 +- module/web/server.scm | 2 +- module/web/uri.scm | 2 +- 6 files changed, 10 insertions(+), 6 deletions(-) diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index 02695d7ba..ae6476891 100644 --- a/module/language/assembly/compile-bytecode.scm +++ b/module/language/assembly/compile-bytecode.scm @@ -24,11 +24,15 @@ #:use-module (system vm instruction) #:use-module (srfi srfi-4) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module ((srfi srfi-1) #:select (fold)) #:use-module ((srfi srfi-26) #:select (cut)) #:export (compile-bytecode)) +;; Gross. +(define (port-position port) + (seek port 0 SEEK_CUR)) + (define (compile-bytecode assembly env . opts) (pmatch assembly ((load-program . _) diff --git a/module/language/elisp/lexer.scm b/module/language/elisp/lexer.scm index ed6c5f8e2..af7e02add 100644 --- a/module/language/elisp/lexer.scm +++ b/module/language/elisp/lexer.scm @@ -394,7 +394,7 @@ (paren-level 0)) (lambda () (if finished - (cons 'eof ((@ (rnrs io ports) eof-object))) + (cons 'eof ((@ (ice-9 binary-ports) eof-object))) (let ((next (lex)) (quotation #f)) (case (car next) diff --git a/module/web/request.scm b/module/web/request.scm index 91cc59da4..84119205f 100644 --- a/module/web/request.scm +++ b/module/web/request.scm @@ -21,7 +21,7 @@ (define-module (web request) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (ice-9 rdelim) #:use-module (srfi srfi-9) #:use-module (web uri) diff --git a/module/web/response.scm b/module/web/response.scm index 2cabd4f85..62837721c 100644 --- a/module/web/response.scm +++ b/module/web/response.scm @@ -21,7 +21,7 @@ (define-module (web response) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (ice-9 rdelim) #:use-module (srfi srfi-9) #:use-module (web http) diff --git a/module/web/server.scm b/module/web/server.scm index 4715cae69..8dbd13961 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -75,7 +75,7 @@ (define-module (web server) #:use-module (srfi srfi-9) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (web request) #:use-module (web response) #:use-module (system repl error-handling) diff --git a/module/web/uri.scm b/module/web/uri.scm index 2361d87b5..23699e921 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -30,7 +30,7 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 control) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:export (uri? uri-scheme uri-userinfo uri-host uri-port uri-path uri-query uri-fragment From 3e05fc04668f2e2c0f0aa989d7adf11bef49ec84 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 18 Feb 2011 19:28:33 +0100 Subject: [PATCH 008/183] fix a couple leaks in ports.c. thanks valgrind! * libguile/ports.c (scm_i_remove_port): Fix a case in which ports explictly closed via close-port would leak their iconv_t data. (scm_set_port_encoding_x): scm_i_set_port_encoding_x strdups its argument, so we need to free the locale encoding of the incoming str. --- libguile/ports.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/libguile/ports.c b/libguile/ports.c index b65650e95..6a51ddc3c 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -661,6 +661,19 @@ scm_i_remove_port (SCM port) scm_port_non_buffer (p); p->putback_buf = NULL; p->putback_buf_size = 0; + + if (p->input_cd != (iconv_t) -1) + { + iconv_close (p->input_cd); + p->input_cd = (iconv_t) -1; + } + + if (p->output_cd != (iconv_t) -1) + { + iconv_close (p->output_cd); + p->output_cd = (iconv_t) -1; + } + SCM_SETPTAB_ENTRY (port, 0); scm_hashq_remove_x (scm_i_port_weak_hash, port); @@ -2099,6 +2112,7 @@ SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0, enc_str = scm_to_locale_string (enc); scm_i_set_port_encoding_x (port, enc_str); + free (enc_str); return SCM_UNSPECIFIED; } From 6bc746d8657de2fd9053b56178770f6c1b151477 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 15 Feb 2011 23:49:48 +0000 Subject: [PATCH 009/183] No sublimated desires * doc/ref/compiler.texi: Delete "subliminated". --- doc/ref/compiler.texi | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index fc0d9c694..f92d05150 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -853,12 +853,12 @@ for more information about the Brainfuck language itself. @subsection Extending the Compiler At this point, we break with the impersonal tone of the rest of the -manual, and make an intervention. Admit it: if you've read this far -into the compiler internals manual, you are a junkie. Perhaps a course -at your university left you unsated, or perhaps you've always harbored -a sublimated desire to hack the holy of computer science holies: a -compiler. Well you're in good company, and in a good position. Guile's -compiler needs your help. +manual, and make an intervention. Admit it: if you've read this far into +the compiler internals manual, you are a junkie. Perhaps a course at +your university left you unsated, or perhaps you've always harbored a +desire to hack the holy of computer science holies: a compiler. Well +you're in good company, and in a good position. Guile's compiler needs +your help. There are many possible avenues for improving Guile's compiler. Probably the most important improvement, speed-wise, will be some form From 8fa6525e82a0fc6f9afabd913e0f64ba158449d8 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 16 Feb 2011 00:17:14 +0000 Subject: [PATCH 010/183] Rewording for "make an intervention". * doc/ref/compiler.texi (Extending the Compiler): Rephrase first sentence. --- doc/ref/compiler.texi | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index f92d05150..86379c71b 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -852,13 +852,12 @@ for more information about the Brainfuck language itself. @node Extending the Compiler @subsection Extending the Compiler -At this point, we break with the impersonal tone of the rest of the -manual, and make an intervention. Admit it: if you've read this far into -the compiler internals manual, you are a junkie. Perhaps a course at -your university left you unsated, or perhaps you've always harbored a -desire to hack the holy of computer science holies: a compiler. Well -you're in good company, and in a good position. Guile's compiler needs -your help. +At this point we take a detour from the impersonal tone of the rest of +the manual. Admit it: if you've read this far into the compiler +internals manual, you are a junkie. Perhaps a course at your university +left you unsated, or perhaps you've always harbored a desire to hack the +holy of computer science holies: a compiler. Well you're in good +company, and in a good position. Guile's compiler needs your help. There are many possible avenues for improving Guile's compiler. Probably the most important improvement, speed-wise, will be some form From a46f77f95cfcc1b4e4de94d1bc135e4d48808725 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 17 Feb 2011 21:36:10 +0000 Subject: [PATCH 011/183] Work on GOOPS MOP documentation * doc/ref/goops.texi (The Metaobject Protocol): Simplify intro text. Minor edits and simplifications throughout this section. (Metaobjects and the Metaobject Protocol): Insert "default". (Metaclasses): Renamed from `Terminology', and deleted the material on CPL and accessors, which just duplicated what has already been covered earlier in the chapter. Remove statements that confuse whether "metaclass of" means "class of class of" or "class of (something that is itself a class)". (I think it's actually the latter.) (Class Definition Protocol): Renamed from `Class Definition Internals'. --- doc/ref/goops.texi | 187 +++++++++++---------------------------------- 1 file changed, 45 insertions(+), 142 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index 3bebd8f5b..76b7dbf26 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -1777,21 +1777,19 @@ So let's plunge in. GOOPS is based on a ``metaobject protocol'' (aka System), tiny-clos (a small Scheme implementation of a subset of CLOS functionality) and STKlos. -GOOPS can be used by application authors at a basic level without any -need to understand what the MOP is and how it works. On the other hand, -the MOP underlies even very simple customizations --- such as defining -an @code{initialize} method to customize the initialization of instances -of an application-defined class --- and an understanding of the MOP -makes it much easier to explain such customizations in a precise way. -And in the long run, understanding the MOP is the key both to -understanding GOOPS at a deeper level and to taking full advantage of -GOOPS' power, by customizing the behaviour of GOOPS itself. +The MOP underlies many possible GOOPS customizations --- such as +defining an @code{initialize} method to customize the initialization of +instances of an application-defined class --- and an understanding of +the MOP makes it much easier to explain such customizations in a precise +way. And at a deeper level, understanding the MOP is a key part of +understanding GOOPS, and of taking full advantage of GOOPS' power, by +customizing the behaviour of GOOPS itself. @menu * Metaobjects and the Metaobject Protocol:: -* Terminology:: +* Metaclasses:: * MOP Specification:: -* Class Definition Internals:: +* Class Definition Protocol:: * Customizing Class Definition:: * Customizing Instance Creation:: * Class Redefinition:: @@ -1828,7 +1826,7 @@ as regards accessibility and protection from garbage collection. Instances are of course objects in the usual sense, and there is no benefit from thinking of them as metaobjects.) -The ``metaobject protocol'' (aka ``MOP'') is the specification of the +The ``metaobject protocol'' (or ``MOP'') is the specification of the generic functions which determine the behaviour of these metaobjects and the circumstances in which these generic functions are invoked. @@ -1854,7 +1852,7 @@ superclasses, slot definitions and class options that were specified in the @code{define-class} form. @item -@code{make} allocates memory for the new instance, and then invokes the +@code{make} allocates memory for the new instance, and invokes the @code{initialize} generic function to initialize the new instance's slots. @@ -1865,8 +1863,8 @@ performs the slot calculation. @end itemize In other words, rather than being hardcoded in @code{define-class}, the -behaviour of class definition is encapsulated by generic function -methods that are specialized for the class @code{}. +default behaviour of class definition is encapsulated by generic +function methods that are specialized for the class @code{}. It is possible to create a new class that inherits from @code{}, which is called a ``metaclass'', and to write a new @code{initialize} @@ -1897,19 +1895,8 @@ Each following section covers a particular area of GOOPS functionality, and describes the generic functions that are relevant for customization of that area. -@node Terminology -@subsection Terminology - -It is assumed that the reader is already familiar with standard object -orientation concepts such as classes, objects/instances, -inheritance/subclassing, generic functions and methods, encapsulation -and polymorphism. - -This section explains some of the less well known concepts and -terminology that GOOPS uses, which are assumed by the following sections -of the reference manual. - -@subsubheading Metaclass +@node Metaclasses +@subsection Metaclasses A @dfn{metaclass} is the class of an object which represents a GOOPS class. Put more succinctly, a metaclass is a class's class. @@ -1925,30 +1912,29 @@ at what happens when a new class is created using @code{define-class}: (define-class () . slots) @end example -GOOPS actually expands the @code{define-class} form to something like -this +@noindent +Guile expands this to something like: @example (define (class () . slots)) @end example -and thence to +@noindent +which in turn expands to: @example (define (make #:supers (list ) #:slots slots)) @end example -In other words, the value of @code{} is in fact an instance of -the class @code{} with slot values specifying the superclasses -and slot definitions for the class @code{}. (@code{#:supers} -and @code{#:slots} are initialization keywords for the @code{dsupers} -and @code{dslots} slots of the @code{} class.) +As this expansion makes clear, the resulting value of @code{} +is an instance of the class @code{} with slot values specifying +the superclasses and slot definitions for the class @code{}. +(@code{#:supers} and @code{#:slots} are initialization keywords for the +@code{dsupers} and @code{dslots} slots of the @code{} class.) -In order to take advantage of the full power of the GOOPS metaobject -protocol (@pxref{MOP Specification}), it is sometimes desirable to -create a new class with a metaclass other than the default -@code{}. This is done by writing: +Now suppose that you want to define a new class with a metaclass other +than the default @code{}. This is done by writing: @example (define-class () @@ -1956,7 +1942,8 @@ create a new class with a metaclass other than the default #:metaclass ) @end example -GOOPS expands this to something like: +@noindent +and Guile expands @emph{this} to something like: @example (define @@ -1992,92 +1979,13 @@ relationships between @code{my-object}, @code{}, @item The class of @code{my-object} is @code{}. -@item -The metaclass of @code{my-object} is @code{}. - @item The class of @code{} is @code{}. -@item -The metaclass of @code{} is @code{}. - @item The class of @code{} is @code{}. - -@item -The metaclass of @code{} is @code{}. - -@item -@code{} is not a metaclass, since it is does not inherit from -@code{}. - -@item -@code{} is a metaclass, since it inherits from -@code{}. @end itemize -@subsubheading Class Precedence List - -The @dfn{class precedence list} of a class is the list of all direct and -indirect superclasses of that class, including the class itself. - -In the absence of multiple inheritance, the class precedence list is -ordered straightforwardly, beginning with the class itself and ending -with @code{}. - -For example, given this inheritance hierarchy: - -@example -(define-class () @dots{}) -(define-class () @dots{}) -(define-class () @dots{}) -@end example - -the class precedence list of would be - -@example -( ) -@end example - -With multiple inheritance, the algorithm is a little more complicated. -A full description is provided by the GOOPS Tutorial: see @ref{Class -Precedence List}. - -``Class precedence list'' is often abbreviated, in documentation and -Scheme variable names, to @dfn{cpl}. - -@subsubheading Accessor - -An @dfn{accessor} is a generic function with both reference and setter -methods. - -@example -(define-accessor perimeter) -@end example - -Reference methods for an accessor are defined in the same way as generic -function methods. - -@example -(define-method (perimeter (s )) - (* 4 (side-length s))) -@end example - -Setter methods for an accessor are defined by specifying ``(setter -)'' as the first parameter of the @code{define-method} -call. - -@example -(define-method ((setter perimeter) (s ) (n )) - (set! (side-length s) (/ n 4))) -@end example - -Once an appropriate setter method has been defined in this way, it can -be invoked using the generalized @code{set!} syntax, as in: - -@example -(set! (perimeter s1) 18.3) -@end example @node MOP Specification @subsection MOP Specification @@ -2087,22 +1995,17 @@ customizable generic function invocations that can be made by the standard GOOPS syntax, procedures and methods, and to explain the protocol for customizing such invocations. -A generic function invocation is customizable if the types of the arguments -to which it is applied are not all determined by the lexical context in -which the invocation appears. For example, +A generic function invocation is customizable if the types of the +arguments to which it is applied are not completely determined by the +lexical context in which the invocation appears. For example, the +@code{(initialize @var{instance} @var{initargs})} invocation in the +default @code{make-instance} method is customizable, because the type of +the @code{@var{instance}} argument is determined by the class that was +passed to @code{make-instance}. -@itemize @bullet -@item -the @code{(initialize @var{instance} @var{initargs})} invocation in the -default @code{make-instance} method is customizable, because the type of the -@code{@var{instance}} argument is determined by the class that was passed to -@code{make-instance}. - -@item -the @code{(make #:name ',name)} invocation in @code{define-generic} -is not customizable, because all of its arguments have lexically determined -types. -@end itemize +(Whereas --- to give a counter-example --- the @code{(make +#:name ',name)} invocation in @code{define-generic} is not customizable, +because all of its arguments have lexically determined types.) When using this rule to decide whether a given generic function invocation is customizable, we ignore arguments that are expected to be handled in @@ -2123,8 +2026,8 @@ effects what the caller expects to get as the applied method's return value. @end itemize -@node Class Definition Internals -@subsection Class Definition Internals +@node Class Definition Protocol +@subsection Class Definition Protocol @code{define-class} (syntax) @@ -2267,7 +2170,7 @@ defines any accessors that are implied by the @var{slot-definition}s @item uses @code{class} to create the new class (@pxref{Class Definition -Internals,, class}) +Protocol,, class}) @item checks for a previous class definition for @var{name} and, if found, @@ -2318,7 +2221,7 @@ class precedence list defaults the @code{#:environment}, @code{#:name} and @code{#:metaclass} options, if they are not specified by @var{options}, to the current top-level environment, the unbound value, and @code{(ensure-metaclass -@var{supers})} respectively (@pxref{Class Definition Internals,, +@var{supers})} respectively (@pxref{Class Definition Protocol,, ensure-metaclass}) @item @@ -2357,7 +2260,7 @@ The @code{env} parameter is ignored. @deffn procedure ensure-metaclass-with-supers meta-supers @code{ensure-metaclass-with-supers} is an internal procedure used by -@code{ensure-metaclass} (@pxref{Class Definition Internals,, +@code{ensure-metaclass} (@pxref{Class Definition Protocol,, ensure-metaclass}). It returns a metaclass that is the union by inheritance of the metaclasses in @var{meta-supers}. @end deffn @@ -2886,11 +2789,11 @@ accessor, passing the setter generic function as the value of the The @code{#:metaclass} class option specifies the metaclass of the class being defined. @var{metaclass} must be a class that inherits from @code{}. For the use of metaclasses, see @ref{Metaobjects and -the Metaobject Protocol} and @ref{Terminology}. +the Metaobject Protocol} and @ref{Metaclasses}. If the @code{#:metaclass} option is absent, GOOPS reuses or constructs a metaclass for the new class by calling @code{ensure-metaclass} -(@pxref{Class Definition Internals,, ensure-metaclass}). +(@pxref{Class Definition Protocol,, ensure-metaclass}). @end deffn @deffn {class option} #:name name From 476a51eb3893d780a1935c0754c9e7854dda8d5a Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 17 Feb 2011 22:09:13 +0000 Subject: [PATCH 012/183] Summarize class definition protocol * doc/ref/goops.texi (Class Definition Protocol): Add tree summary diagram. --- doc/ref/goops.texi | 82 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index 76b7dbf26..a5020d167 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -2029,6 +2029,88 @@ what the caller expects to get as the applied method's return value. @node Class Definition Protocol @subsection Class Definition Protocol +Here is a summary diagram of the syntax, procedures and generic +functions that may be involved in class definition. + +@noindent +@code{define-class} (syntax) + +@itemize @bullet +@item +@code{class} (syntax) + +@itemize @bullet +@item +@code{make-class} (procedure) + +@itemize @bullet +@item +@code{ensure-metaclass} (procedure) + +@itemize @bullet +@item +@code{ensure-metaclass-with-supers} (procedure) +@end itemize + +@item +@code{make @var{metaclass} @dots{}} (generic) + +@itemize @bullet +@item +@code{allocate-instance} (generic) + +@item +@code{initialize} (generic) + +@itemize @bullet +@item +@code{compute-cpl} (generic) + +@itemize @bullet +@item +@code{compute-std-cpl} (procedure) +@end itemize + +@item +@code{compute-slots} (generic) + +@item +@code{compute-get-n-set} (generic) + +@item +@code{compute-getter-method} (generic) + +@item +@code{compute-setter-method} (generic) +@end itemize +@end itemize +@end itemize +@end itemize + +@item +@code{class-redefinition} (generic) + +@itemize @bullet +@item +@code{remove-class-accessors} (generic) + +@item +@code{update-direct-method!} (generic) + +@item +@code{update-direct-subclass!} (generic) +@end itemize +@end itemize + +Wherever a step above is marked as ``generic'', it can be customized, +and the detail shown below it is only ``correct'' insofar as it +describes what the default method of that generic function does. For +example, if you write an @code{initialize} method, for some metaclass, +that does not call @code{next-method} and does not call +@code{compute-cpl}, then @code{compute-cpl} will not be called when a +class is defined with that metaclass. + + @code{define-class} (syntax) @itemize @bullet From d9ff8506b32495393a77b7a2d077172d12571a34 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 18 Feb 2011 19:47:05 +0000 Subject: [PATCH 013/183] Doc of MOP for instance and class creation * doc/ref/goops.texi (Instance Creation Protocol): Rename from `Customizing Instance Creation', and move before the more complicated class definition stuff. Couple of very minor edits. (Class Definition Protocol): Remove ensure-metaclass-with-supers (too internal) and repeated material. Move class-redefinition stuff to (existing) later section on that. Merge reference-like material from `Customizing Class Definition' to here. --- doc/ref/goops.texi | 464 ++++++++++++++++++++------------------------- 1 file changed, 201 insertions(+), 263 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index a5020d167..890081ac9 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -1789,9 +1789,9 @@ customizing the behaviour of GOOPS itself. * Metaobjects and the Metaobject Protocol:: * Metaclasses:: * MOP Specification:: +* Instance Creation Protocol:: * Class Definition Protocol:: * Customizing Class Definition:: -* Customizing Instance Creation:: * Class Redefinition:: * Method Definition:: * Method Definition Internals:: @@ -2026,6 +2026,93 @@ effects what the caller expects to get as the applied method's return value. @end itemize + +@node Instance Creation Protocol +@subsection Instance Creation Protocol + +@code{make . @var{initargs}} (method) + +@itemize @bullet +@item +@code{allocate-instance @var{class} @var{initargs}} (generic) + +The applied @code{allocate-instance} method should allocate storage for +a new instance of class @var{class} and return the uninitialized instance. + +@item +@code{initialize @var{instance} @var{initargs}} (generic) + +@var{instance} is the uninitialized instance returned by +@code{allocate-instance}. The applied method should initialize the new +instance in whatever sense is appropriate for its class. The method's +return value is ignored. +@end itemize + +@code{make} itself is a generic function. Hence the @code{make} +invocation itself can be customized in the case where the new instance's +metaclass is more specialized than the default @code{}, by +defining a @code{make} method that is specialized to that metaclass. + +Normally, however, the method for classes with metaclass @code{} +will be applied. This method calls two generic functions: + +@itemize @bullet +@item +(allocate-instance @var{class} . @var{initargs}) + +@item +(initialize @var{instance} . @var{initargs}) +@end itemize + +@code{allocate-instance} allocates storage for and returns the new +instance, uninitialized. You might customize @code{allocate-instance}, +for example, if you wanted to provide a GOOPS wrapper around some other +object programming system. + +To do this, you would create a specialized metaclass, which would act as +the metaclass for all classes and instances from the other system. Then +define an @code{allocate-instance} method, specialized to that +metaclass, which calls a Guile primitive C function (or FFI code), which +in turn allocates the new instance using the interface of the other +object system. + +In this case, for a complete system, you would also need to customize a +number of other generic functions like @code{make} and +@code{initialize}, so that GOOPS knows how to make classes from the +other system, access instance slots, and so on. + +@code{initialize} initializes the instance that is returned by +@code{allocate-instance}. The standard GOOPS methods perform +initializations appropriate to the instance class. + +@itemize @bullet +@item +At the least specialized level, the method for instances of type +@code{} performs internal GOOPS instance initialization, and +initializes the instance's slots according to the slot definitions and +any slot initialization keywords that appear in @var{initargs}. + +@item +The method for instances of type @code{} calls +@code{(next-method)}, then performs the class initializations described +in @ref{Class Definition Protocol}. + +@item +and so on for generic functions, methods, operator classes @dots{} +@end itemize + +Similarly, you can customize the initialization of instances of any +application-defined class by defining an @code{initialize} method +specialized to that class. + +Imagine a class whose instances' slots need to be initialized at +instance creation time by querying a database. Although it might be +possible to achieve this a combination of @code{#:init-thunk} keywords +and closures in the slot definitions, it may be neater to write an +@code{initialize} method for the class that queries the database once +and initializes all the dependent slot values according to the results. + + @node Class Definition Protocol @subsection Class Definition Protocol @@ -2047,11 +2134,6 @@ functions that may be involved in class definition. @item @code{ensure-metaclass} (procedure) -@itemize @bullet -@item -@code{ensure-metaclass-with-supers} (procedure) -@end itemize - @item @code{make @var{metaclass} @dots{}} (generic) @@ -2110,47 +2192,119 @@ that does not call @code{next-method} and does not call @code{compute-cpl}, then @code{compute-cpl} will not be called when a class is defined with that metaclass. - -@code{define-class} (syntax) +A @code{(define-class ...)} form (@pxref{Class Definition}) expands to +an expression which @itemize @bullet @item -@code{class} (syntax) +checks that it is being evaluated only at top level + +@item +defines any accessors that are implied by the @var{slot-definition}s + +@item +uses @code{class} to create the new class + +@item +checks for a previous class definition for @var{name} and, if found, +handles the redefinition by invoking @code{class-redefinition} +(@pxref{Redefining a Class}). +@end itemize + +@deffn syntax class name (super @dots{}) slot-definition @dots{} . options +Return a newly created class that inherits from @var{super}s, with +direct slots defined by @var{slot-definition}s and class options +@var{options}. For the format of @var{slot-definition}s and +@var{options}, see @ref{Class Definition,, define-class}. +@end deffn + +@noindent @code{class} expands to an expression which @itemize @bullet @item -@code{make-class} (procedure) +processes the class and slot definition options to check that they are +well-formed, to convert the @code{#:init-form} option to an +@code{#:init-thunk} option, to supply a default environment parameter +(the current top-level environment) and to evaluate all the bits that +need to be evaluated + +@item +calls @code{make-class} to create the class with the processed and +evaluated parameters. +@end itemize + +@deffn procedure make-class supers slots . options +Return a newly created class that inherits from @var{supers}, with +direct slots defined by @var{slots} and class options @var{options}. +For the format of @var{slots} and @var{options}, see @ref{Class +Definition,, define-class}, except note that for @code{make-class}, +@var{slots} and @var{options} are separate list parameters: @var{slots} +here is a list of slot definitions. +@end deffn + +@noindent @code{make-class} @itemize @bullet @item -@code{make @var{metaclass} @dots{}} (generic) +adds @code{} to the @var{supers} list if @var{supers} is empty +or if none of the classes in @var{supers} have @code{} in their +class precedence list +@item +defaults the @code{#:environment}, @code{#:name} and @code{#:metaclass} +options, if they are not specified by @var{options}, to the current +top-level environment, the unbound value, and @code{(ensure-metaclass +@var{supers})} respectively + +@item +checks for duplicate classes in @var{supers} and duplicate slot names in +@var{slots}, and signals an error if there are any duplicates + +@item +calls @code{make}, passing the metaclass as the first parameter and all +other parameters as option keywords with values. +@end itemize + +@deffn procedure ensure-metaclass supers env +Return a metaclass suitable for a class that inherits from the list of +classes in @var{supers}. The returned metaclass is the union by +inheritance of the metaclasses of the classes in @var{supers}. + +In the simplest case, where all the @var{supers} are straightforward +classes with metaclass @code{}, the returned metaclass is just +@code{}. + +For a more complex example, suppose that @var{supers} contained one +class with metaclass @code{} and one with metaclass +@code{}. Then the returned metaclass would be a +class that inherits from both @code{} and +@code{}. + +If @var{supers} is the empty list, @code{ensure-metaclass} returns the +default GOOPS metaclass @code{}. + +GOOPS keeps a list of the metaclasses created by +@code{ensure-metaclass}, so that each required type of metaclass only +has to be created once. + +The @code{env} parameter is ignored. +@end deffn + +@deffn generic make metaclass @dots{} @var{metaclass} is the metaclass of the class being defined, either taken from the @code{#:metaclass} class option or computed by @code{ensure-metaclass}. The applied method must create and return the fully initialized class metaobject for the new class definition. -@end itemize +@end deffn -@end itemize +The @code{(make @var{metaclass} @dots{})} invocation is a particular +case of the instance creation protocol covered in the previous section. +It will create an class metaobject with metaclass @var{metaclass}. By +default, this metaobject will be initialized by the @code{initialize} +method that is specialized for instances of type @code{}. -@item -@code{class-redefinition @var{old-class} @var{new-class}} (generic) - -@code{define-class} calls @code{class-redefinition} if the variable -specified by its first argument already held a GOOPS class definition. -@var{old-class} and @var{new-class} are the old and new class metaobjects. -The applied method should perform whatever is necessary to handle the -redefinition, and should return the class metaobject that is to be bound -to @code{define-class}'s variable. The default class redefinition -protocol is described in @ref{Class Redefinition}. -@end itemize - -The @code{(make @var{metaclass} @dots{})} invocation above will create -an class metaobject with metaclass @var{metaclass}. By default, this -metaobject will be initialized by the @code{initialize} method that is -specialized for instances of type @code{}. - -@code{initialize @var{initargs}} (method) +The @code{initialize} method for classes (signature @code{(initialize + initargs)}) calls the following generic functions. @itemize @bullet @item @@ -2241,154 +2395,9 @@ to the generic function named by the slot definition's @code{#:setter} or @code{#:accessor} option. @end itemize -@code{define-class} expands to an expression which - -@itemize @bullet -@item -checks that it is being evaluated only at top level - -@item -defines any accessors that are implied by the @var{slot-definition}s - -@item -uses @code{class} to create the new class (@pxref{Class Definition -Protocol,, class}) - -@item -checks for a previous class definition for @var{name} and, if found, -handles the redefinition by invoking @code{class-redefinition} -(@pxref{Redefining a Class}). -@end itemize - -@deffn syntax class name (super @dots{}) slot-definition @dots{} . options -Return a newly created class that inherits from @var{super}s, with -direct slots defined by @var{slot-definition}s and class options -@var{options}. For the format of @var{slot-definition}s and -@var{options}, see @ref{Class Definition,, define-class}. -@end deffn - -@noindent @code{class} expands to an expression which - -@itemize @bullet -@item -processes the class and slot definition options to check that they are -well-formed, to convert the @code{#:init-form} option to an -@code{#:init-thunk} option, to supply a default environment parameter -(the current top-level environment) and to evaluate all the bits that -need to be evaluated - -@item -calls @code{make-class} to create the class with the processed and -evaluated parameters. -@end itemize - -@deffn procedure make-class supers slots . options -Return a newly created class that inherits from @var{supers}, with -direct slots defined by @var{slots} and class options @var{options}. -For the format of @var{slots} and @var{options}, see @ref{Class -Definition,, define-class}, except note that for @code{make-class}, -@var{slots} and @var{options} are separate list parameters: @var{slots} -here is a list of slot definitions. -@end deffn - -@noindent @code{make-class} - -@itemize @bullet -@item -adds @code{} to the @var{supers} list if @var{supers} is empty -or if none of the classes in @var{supers} have @code{} in their -class precedence list - -@item -defaults the @code{#:environment}, @code{#:name} and @code{#:metaclass} -options, if they are not specified by @var{options}, to the current -top-level environment, the unbound value, and @code{(ensure-metaclass -@var{supers})} respectively (@pxref{Class Definition Protocol,, -ensure-metaclass}) - -@item -checks for duplicate classes in @var{supers} and duplicate slot names in -@var{slots}, and signals an error if there are any duplicates - -@item -calls @code{make}, passing the metaclass as the first parameter and all -other parameters as option keywords with values. -@end itemize - -@deffn procedure ensure-metaclass supers env -Return a metaclass suitable for a class that inherits from the list of -classes in @var{supers}. The returned metaclass is the union by -inheritance of the metaclasses of the classes in @var{supers}. - -In the simplest case, where all the @var{supers} are straightforward -classes with metaclass @code{}, the returned metaclass is just -@code{}. - -For a more complex example, suppose that @var{supers} contained one -class with metaclass @code{} and one with metaclass -@code{}. Then the returned metaclass would be a -class that inherits from both @code{} and -@code{}. - -If @var{supers} is the empty list, @code{ensure-metaclass} returns the -default GOOPS metaclass @code{}. - -GOOPS keeps a list of the metaclasses created by -@code{ensure-metaclass}, so that each required type of metaclass only -has to be created once. - -The @code{env} parameter is ignored. -@end deffn - -@deffn procedure ensure-metaclass-with-supers meta-supers -@code{ensure-metaclass-with-supers} is an internal procedure used by -@code{ensure-metaclass} (@pxref{Class Definition Protocol,, -ensure-metaclass}). It returns a metaclass that is the union by -inheritance of the metaclasses in @var{meta-supers}. -@end deffn - -The internals of @code{make}, which is ultimately used to create the new -class object, are described in @ref{Customizing Instance Creation}, -which covers the creation and initialization of instances in general. - @node Customizing Class Definition @subsection Customizing Class Definition -During the initialization of a new class, GOOPS calls a number of generic -functions with the newly allocated class instance as the first -argument. Specifically, GOOPS calls the generic function - -@itemize @bullet -@item -(initialize @var{class} @dots{}) -@end itemize - -where @var{class} is the newly allocated class instance, and the default -@code{initialize} method for arguments of type @code{} calls the -generic functions - -@itemize @bullet -@item -(compute-cpl @var{class}) - -@item -(compute-slots @var{class}) - -@item -(compute-get-n-set @var{class} @var{slot-def}), for each of the slot -definitions returned by @code{compute-slots} - -@item -(compute-getter-method @var{class} @var{slot-def}), for each of the -slot definitions returned by @code{compute-slots} that includes a -@code{#:getter} or @code{#:accessor} slot option - -@item -(compute-setter-method @var{class} @var{slot-def}), for each of the -slot definitions returned by @code{compute-slots} that includes a -@code{#:setter} or @code{#:accessor} slot option. -@end itemize - If the metaclass of the new class is something more specialized than the default @code{}, then the type of @var{class} in the calls above is more specialized than @code{}, and hence it becomes possible @@ -2406,8 +2415,7 @@ customized in order to modify the CPL ordering algorithm for all classes with a special metaclass. The default CPL algorithm is encapsulated by the @code{compute-std-cpl} -procedure, which is in turn called by the default @code{compute-cpl} -method. +procedure, which is called by the default @code{compute-cpl} method. @deffn procedure compute-std-cpl class Compute and return the class precedence list for @var{class} according @@ -2476,7 +2484,7 @@ allocation to do this. @end example The usage of @code{compute-getter-method} and @code{compute-setter-method} -is described in @ref{MOP Specification}. +is described in @ref{Class Definition Protocol}. @code{compute-cpl} and @code{compute-get-n-set} are called by the standard @code{initialize} method for classes whose metaclass is @@ -2487,94 +2495,24 @@ behaviour, by not calling @code{(next-method)} at all, but more typically it would perform additional class initialization steps before and/or after calling @code{(next-method)} for the standard behaviour. -@node Customizing Instance Creation -@subsection Customizing Instance Creation - -@code{make . @var{initargs}} (method) - -@itemize @bullet -@item -@code{allocate-instance @var{class} @var{initargs}} (generic) - -The applied @code{allocate-instance} method should allocate storage for -a new instance of class @var{class} and return the uninitialized instance. - -@item -@code{initialize @var{instance} @var{initargs}} (generic) - -@var{instance} is the uninitialized instance returned by -@code{allocate-instance}. The applied method should initialize the new -instance in whatever sense is appropriate for its class. The method's -return value is ignored. -@end itemize - -@code{make} itself is a generic function. Hence the @code{make} -invocation itself can be customized in the case where the new instance's -metaclass is more specialized than the default @code{}, by -defining a @code{make} method that is specialized to that metaclass. - -Normally, however, the method for classes with metaclass @code{} -will be applied. This method calls two generic functions: - -@itemize @bullet -@item -(allocate-instance @var{class} . @var{initargs}) - -@item -(initialize @var{instance} . @var{initargs}) -@end itemize - -@code{allocate-instance} allocates storage for and returns the new -instance, uninitialized. You might customize @code{allocate-instance}, -for example, if you wanted to provide a GOOPS wrapper around some other -object programming system. - -To do this, you would create a specialized metaclass, which would act as -the metaclass for all classes and instances from the other system. Then -define an @code{allocate-instance} method, specialized to that -metaclass, which calls a Guile primitive C function, which in turn -allocates the new instance using the interface of the other object -system. - -In this case, for a complete system, you would also need to customize a -number of other generic functions like @code{make} and -@code{initialize}, so that GOOPS knows how to make classes from the -other system, access instance slots, and so on. - -@code{initialize} initializes the instance that is returned by -@code{allocate-instance}. The standard GOOPS methods perform -initializations appropriate to the instance class. - -@itemize @bullet -@item -At the least specialized level, the method for instances of type -@code{} performs internal GOOPS instance initialization, and -initializes the instance's slots according to the slot definitions and -any slot initialization keywords that appear in @var{initargs}. - -@item -The method for instances of type @code{} calls -@code{(next-method)}, then performs the class initializations described -in @ref{Customizing Class Definition}. - -@item -and so on for generic functions, method, operator classes @dots{} -@end itemize - -Similarly, you can customize the initialization of instances of any -application-defined class by defining an @code{initialize} method -specialized to that class. - -Imagine a class whose instances' slots need to be initialized at -instance creation time by querying a database. Although it might be -possible to achieve this a combination of @code{#:init-thunk} keywords -and closures in the slot definitions, it is neater to write an -@code{initialize} method for the class that queries the database once -and initializes all the dependent slot values according to the results. @node Class Redefinition @subsection Class Redefinition +@itemize @bullet + +@item +@code{class-redefinition @var{old-class} @var{new-class}} (generic) + +@code{define-class} calls @code{class-redefinition} if the variable +specified by its first argument already held a GOOPS class definition. +@var{old-class} and @var{new-class} are the old and new class metaobjects. +The applied method should perform whatever is necessary to handle the +redefinition, and should return the class metaobject that is to be bound +to @code{define-class}'s variable. The default class redefinition +protocol is described in @ref{Class Redefinition}. +@end itemize + The default @code{class-redefinition} method, specialized for classes with the default metaclass @code{}, has the following internal protocol. From b0fc1b9f379e31ed5755ff991e9d8c97ce67fc8c Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 18 Feb 2011 20:50:55 +0000 Subject: [PATCH 014/183] Merge orphan Class Options section into Class Definition * doc/ref/goops.texi (Class Definition): Move material from later `Class Options' section to here. --- doc/ref/goops.texi | 53 +++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 29 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index 890081ac9..d522fae8f 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -48,7 +48,6 @@ module. You can do this at the Guile REPL by evaluating: * GOOPS Error Handling:: * GOOPS Object Miscellany:: * The Metaobject Protocol:: -* Class Options:: * Redefining a Class:: * Changing the Class of an Instance:: @end menu @@ -94,8 +93,8 @@ that class --- like ``fields'' or ``member variables'' in other object oriented systems. Each @var{slot-description} gives the name of a slot and optionally some ``properties'' of this slot; for example its initial value, the name of a function which will access its value, and so on. -Slot descriptions and inheritance are discussed more below. For class -options, see @ref{Class Options}. +Class options, slot descriptions and inheritance are discussed more +below. @cindex slot @deffn syntax define-class name (super @dots{}) slot-definition @dots{} . options @@ -140,8 +139,28 @@ the predefined class @code{}; @code{} is the superclass of @code{}, and @code{} is the superclass of @code{}.} -The possible slot and class options are described in the following -sections. +Slot options are described in the next section. The possible class +options are as follows. + +@deffn {class option} #:metaclass metaclass +The @code{#:metaclass} class option specifies the metaclass of the class +being defined. @var{metaclass} must be a class that inherits from +@code{}. For the use of metaclasses, see @ref{Metaobjects and +the Metaobject Protocol} and @ref{Metaclasses}. + +If the @code{#:metaclass} option is absent, GOOPS reuses or constructs a +metaclass for the new class by calling @code{ensure-metaclass} +(@pxref{Class Definition Protocol,, ensure-metaclass}). +@end deffn + +@deffn {class option} #:name name +The @code{#:name} class option specifies the new class's name. This +name is used to identify the class whenever related objects - the class +itself, its instances and its subclasses - are printed. + +If the @code{#:name} option is absent, GOOPS uses the first argument to +@code{define-class} as the class name. +@end deffn @node Instance Creation @@ -2802,30 +2821,6 @@ accessor, passing the setter generic function as the value of the @end itemize -@node Class Options -@section Class Options - -@deffn {class option} #:metaclass metaclass -The @code{#:metaclass} class option specifies the metaclass of the class -being defined. @var{metaclass} must be a class that inherits from -@code{}. For the use of metaclasses, see @ref{Metaobjects and -the Metaobject Protocol} and @ref{Metaclasses}. - -If the @code{#:metaclass} option is absent, GOOPS reuses or constructs a -metaclass for the new class by calling @code{ensure-metaclass} -(@pxref{Class Definition Protocol,, ensure-metaclass}). -@end deffn - -@deffn {class option} #:name name -The @code{#:name} class option specifies the new class's name. This -name is used to identify the class whenever related objects - the class -itself, its instances and its subclasses - are printed. - -If the @code{#:name} option is absent, GOOPS uses the first argument to -@code{define-class} as the class name. -@end deffn - - @node Redefining a Class @section Redefining a Class From ed478161f38b3c1bbe2a37a18e0b49d92f399df0 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 18 Feb 2011 22:15:11 +0000 Subject: [PATCH 015/183] Clean up doc on class redefinition and instance class changing * doc/ref/goops.texi (Class Redefinition): Deleted, with its material all merged into later `Redefining a Class' and `Changing the Class of an Instance' sections. --- doc/ref/goops.texi | 153 ++++++++++++++------------------------------- 1 file changed, 46 insertions(+), 107 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index d522fae8f..fc114f2c1 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -1811,7 +1811,6 @@ customizing the behaviour of GOOPS itself. * Instance Creation Protocol:: * Class Definition Protocol:: * Customizing Class Definition:: -* Class Redefinition:: * Method Definition:: * Method Definition Internals:: * Generic Function Internals:: @@ -2515,82 +2514,6 @@ typically it would perform additional class initialization steps before and/or after calling @code{(next-method)} for the standard behaviour. -@node Class Redefinition -@subsection Class Redefinition - -@itemize @bullet - -@item -@code{class-redefinition @var{old-class} @var{new-class}} (generic) - -@code{define-class} calls @code{class-redefinition} if the variable -specified by its first argument already held a GOOPS class definition. -@var{old-class} and @var{new-class} are the old and new class metaobjects. -The applied method should perform whatever is necessary to handle the -redefinition, and should return the class metaobject that is to be bound -to @code{define-class}'s variable. The default class redefinition -protocol is described in @ref{Class Redefinition}. -@end itemize - -The default @code{class-redefinition} method, specialized for classes -with the default metaclass @code{}, has the following internal -protocol. - -@code{class-redefinition (@var{old }) (@var{new })} -(method) - -@itemize @bullet -@item -@code{remove-class-accessors! @var{old}} (generic) - -@item -@code{update-direct-method! @var{method} @var{old} @var{new}} (generic) - -@item -@code{update-direct-subclass! @var{subclass} @var{old} @var{new}} (generic) -@end itemize - -This protocol cleans up things that the definition of the old class -once changed and modifies things to work with the new class. - -The default @code{remove-class-accessors!} method removes the -accessor methods of the old class from all classes which they -specialize. - -The default @code{update-direct-method!} method substitutes the new -class for the old in all methods specialized to the old class. - -The default @code{update-direct-subclass!} method invokes -@code{class-redefinition} recursively to handle the redefinition of -subclasses. - -When a class is redefined, any existing instance of the redefined class -will be modified for the new class definition before the next time that -any of the instance's slot is referenced or set. GOOPS modifies each -instance by calling the generic function @code{change-class}. - -The default @code{change-class} method copies slot values from the old -to the modified instance, and initializes new slots, as described in -@ref{Changing the Class of an Instance}. After doing so, it makes a -generic function invocation that can be used to customize the instance -update algorithm. - -@code{change-class (@var{old-instance }) (@var{new })} (method) - -@itemize @bullet -@item -@code{update-instance-for-different-class @var{old-instance} @var{new-instance}} (generic) - -@code{change-class} invokes @code{update-instance-for-different-class} -as the last thing that it does before returning. The applied method can -make any further adjustments to @var{new-instance} that are required to -complete or modify the change of class. The return value from the -applied method is ignored. - -The default @code{update-instance-for-different-class} method does -nothing. -@end itemize - @node Method Definition @subsection Method Definition @@ -2892,8 +2815,8 @@ be customized@dots{} @node Customizing Class Redefinition @subsection Customizing Class Redefinition -When @code{define-class} notices that a class is being redefined, -it constructs the new class metaobject as usual, and then invokes the +When @code{define-class} notices that a class is being redefined, it +constructs the new class metaobject as usual, then invokes the @code{class-redefinition} generic function with the old and new classes as arguments. Therefore, if the old or new classes have metaclasses other than the default @code{}, class redefinition behaviour can @@ -2912,6 +2835,26 @@ Implements GOOPS' default class redefinition behaviour, as described in for the new class definition. @end deffn +The default @code{class-redefinition} method, for classes with the +default metaclass @code{}, calls the following generic functions, +which could of course be individually customized. + +@deffn generic remove-class-accessors! old +The default @code{remove-class-accessors!} method removes the accessor +methods of the old class from all classes which they specialize. +@end deffn + +@deffn generic update-direct-method! method old new +The default @code{update-direct-method!} method substitutes the new +class for the old in all methods specialized to the old class. +@end deffn + +@deffn generic update-direct-subclass! subclass old new +The default @code{update-direct-subclass!} method invokes +@code{class-redefinition} recursively to handle the redefinition of +subclasses. +@end deffn + An alternative class redefinition strategy could be to leave all existing instances as instances of the old class, but accepting that the old class is now ``nameless'', since its name has been taken over by the @@ -2935,34 +2878,18 @@ is specialized for this metaclass: When customization can be as easy as this, aren't you glad that GOOPS implements the far more difficult strategy as its default! -Finally, note that, if @code{class-redefinition} itself is not customized, -the default @code{class-redefinition} method invokes three further -generic functions that could be individually customized: - -@itemize @bullet -@item -(remove-class-accessors! @var{old-class}) - -@item -(update-direct-method! @var{method} @var{old-class} @var{new-class}) - -@item -(update-direct-subclass! @var{subclass} @var{old-class} @var{new-class}) -@end itemize - -and the default methods for these generic functions invoke further -generic functions, and so on@dots{} The detailed protocol for all of these -is described in @ref{MOP Specification}. @node Changing the Class of an Instance @section Changing the Class of an Instance -You can change the class of an existing instance by invoking the -generic function @code{change-class} with two arguments: the instance -and the new class. +When a class is redefined, any existing instance of the redefined class +will be modified for the new class definition before the next time that +any of the instance's slots is referenced or set. GOOPS modifies each +instance by calling the generic function @code{change-class}. -@deffn generic change-class -@end deffn +More generally, you can change the class of an existing instance at any +time by invoking the generic function @code{change-class} with two +arguments: the instance and the new class. The default method for @code{change-class} decides how to implement the change of class by looking at the slot definitions for the instance's @@ -2973,6 +2900,9 @@ discarded. Slots that are present only in the new class are initialized using the corresponding slot definition's init function (@pxref{Classes,, slot-init-function}). +@deffn generic change-class instance new-class +@end deffn + @deffn {method} change-class (obj ) (new ) Modify instance @var{obj} to make it an instance of class @var{new}. @@ -2984,11 +2914,20 @@ pre-existing slots are initialized according to @var{new}'s slot definitions' init functions. @end deffn +The default @code{change-class} method also invokes another generic +function, @code{update-instance-for-different-class}, as the last thing +that it does before returning. The applied +@code{update-instance-for-different-class} method can make any further +adjustments to @var{new-instance} that are required to complete or +modify the change of class. The return value from the applied method is +ignored. + +@deffn generic update-instance-for-different-class old-instance new-instance +A generic function that can be customized to put finishing touches to an +instance whose class has just been changed. The default +@code{update-instance-for-different-class} method does nothing. +@end deffn + Customized change of class behaviour can be implemented by defining @code{change-class} methods that are specialized either by the class of the instances to be modified or by the metaclass of the new class. - -When a class is redefined (@pxref{Redefining a Class}), and the default -class redefinition behaviour is not overridden, GOOPS (eventually) -invokes the @code{change-class} generic function for each existing -instance of the redefined class. From bba1a2c73d93a1b47712151ea9b0d28953e517e7 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 18 Feb 2011 22:46:02 +0000 Subject: [PATCH 016/183] Tidy up remaining bits of the MOP section * doc/ref/goops.texi (Method Definition): Unindent text about define-method invoking add-method!. (Method Definition Internals): Add @noindent's. (Generic Function Invocation): Add intro text, and tidy up the tree. --- doc/ref/goops.texi | 62 ++++++++++++++++++++++++---------------------- 1 file changed, 33 insertions(+), 29 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index fc114f2c1..e905dbb64 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -2522,7 +2522,9 @@ and/or after calling @code{(next-method)} for the standard behaviour. @itemize @bullet @item @code{add-method! @var{target} @var{method}} (generic) +@end itemize +@noindent @code{define-method} invokes the @code{add-method!} generic function to handle adding the new method to a variety of possible targets. GOOPS includes methods to handle @var{target} as @@ -2540,12 +2542,12 @@ a primitive generic (@pxref{Extending Primitives}) By defining further methods for @code{add-method!}, you can theoretically handle adding methods to further types of target. -@end itemize + @node Method Definition Internals @subsection Method Definition Internals -@code{define-method} +@code{define-method}: @itemize @bullet @item @@ -2575,7 +2577,8 @@ The @var{parameter} and @var{body} parameters should be as for define-method}). @end deffn -@code{method} +@noindent +@code{method}: @itemize @bullet @item @@ -2601,6 +2604,7 @@ parameter combinations to which this method will be applicable. function parameters when this method is invoked. @end deffn +@noindent @code{make-method} is a simple wrapper around @code{make} with metaclass @code{}. @@ -2701,47 +2705,47 @@ accessor, passing the setter generic function as the value of the @node Generic Function Invocation @subsection Generic Function Invocation -[ *fixme* Description required here. ] +There is a detailed and customizable protocol involved in the process of +invoking a generic function --- i.e., in the process of deciding which +of the generic function's methods are applicable to the current +arguments, and which one of those to apply. Here is a summary diagram +of the generic functions involved. -@code{apply-generic} +@noindent +@code{apply-generic} (generic) @itemize @bullet @item -@code{no-method} +@code{no-method} (generic) @item -@code{compute-applicable-methods} +@code{compute-applicable-methods} (generic) @item -@code{sort-applicable-methods} +@code{sort-applicable-methods} (generic) + +@itemize @bullet +@item +@code{method-more-specific?} (generic) +@end itemize @item -@code{apply-methods} +@code{apply-methods} (generic) + +@itemize @bullet +@item +@code{apply-method} (generic) + +@item +@code{no-next-method} (generic) +@end itemize @item @code{no-applicable-method} @end itemize -@code{sort-applicable-methods} - -@itemize @bullet -@item -@code{method-more-specific?} -@end itemize - -@code{apply-methods} - -@itemize @bullet -@item -@code{apply-method} -@end itemize - -@code{next-method} - -@itemize @bullet -@item -@code{no-next-method} -@end itemize +We do not yet have full documentation for these. Please refer to the +code (@file{oop/goops.scm}) for details. @node Redefining a Class From 27643d70976b1d5cf2ecea50cf11130654c01ba4 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 18 Feb 2011 22:53:57 +0000 Subject: [PATCH 017/183] Remove unneeded fixme * doc/ref/goops.texi (Class Definition Protocol): Removed `*fixme Need to insert something here about checking that the value is not unbound'. It's a fine detail, and also I imagine there could be a valid application that would choose to allow SCM_GOOPS_UNBOUND values to escape through here. --- doc/ref/goops.texi | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index e905dbb64..c6d272e47 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -2387,15 +2387,14 @@ calls@dots{} @item @code{compute-getter-method @var{class} @var{gns}} (generic) -@code{initialize} calls @code{compute-getter-method} for each of the class's -slots (as determined by @code{compute-slots}) that includes a +@code{initialize} calls @code{compute-getter-method} for each of the +class's slots (as determined by @code{compute-slots}) that includes a @code{#:getter} or @code{#:accessor} slot option. @var{gns} is the -element of the @var{class} metaobject's @code{getters-n-setters} slot that -specifies how the slot in question is referenced and set, as described -above under @code{compute-get-n-set}. The applied method should create -and return a method that is specialized for instances of type @var{class} -and uses the get closure to retrieve the slot's value. [ *fixme Need -to insert something here about checking that the value is not unbound. ] +element of the @var{class} metaobject's @code{getters-n-setters} slot +that specifies how the slot in question is referenced and set, as +described above under @code{compute-get-n-set}. The applied method +should create and return a method that is specialized for instances of +type @var{class} and uses the get closure to retrieve the slot's value. @code{initialize} uses @code{add-method!} to add the returned method to the generic function named by the slot definition's @code{#:getter} or @code{#:accessor} option. From e888334c27c218cb187a6540d2182232361eb7c3 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 18 Feb 2011 23:10:54 +0000 Subject: [PATCH 018/183] Last (for a little while) GOOPs doc fix * doc/ref/goops.texi (GOOPS Object Miscellany): Clarify that it would be instances being printed, not classes. --- doc/ref/goops.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index c6d272e47..95e71da82 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -1777,7 +1777,7 @@ as the Guile primitive @code{write} and @code{display} functions. In addition to the cases mentioned, you can of course define @code{write} and @code{display} methods for your own classes, to -customize how they are printed. +customize how instances of those classes are printed. @node The Metaobject Protocol From 5ec48b704522c861c6e34ed1cbbfec5b89d55376 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 21 Jan 2011 19:34:01 +0000 Subject: [PATCH 019/183] Fix typos in (web ...) doc * doc/ref/web.texi (Types and the Web): "help" -> "helpful". (HTTP): Add closing paren. Remove code that looks like a leftover. --- doc/ref/web.texi | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/doc/ref/web.texi b/doc/ref/web.texi index c7018e9c6..a72a18701 100644 --- a/doc/ref/web.texi +++ b/doc/ref/web.texi @@ -59,8 +59,8 @@ valid dates. Error handling for a number of basic cases, like invalid dates, occurs on the boundary in which we produce a SRFI 19 date record from other types, like strings. -With regards to the web, data types are help in the two broad phases of -HTTP messages: parsing and generation. +With regards to the web, data types are helpful in the two broad phases +of HTTP messages: parsing and generation. Consider a server, which has to parse a request, and produce a response. Guile will parse the request into an HTTP request object @@ -339,7 +339,7 @@ For example: (string->header "FOO") @result{} foo -(header->string 'foo +(header->string 'foo) @result{} "Foo" @end example @@ -387,12 +387,6 @@ leaving it as a string. You could register this header with Guile's HTTP stack like this: @example -(define (parse-ip str) - (inet-aton str) -(define (validate-ip ip) -(define (write-ip ip port) - (display (inet-ntoa ip) port)) - (declare-header! "X-Client-Address" (lambda (str) (inet-aton str)) From 1867d3e0195168a34cf2269c2137ac561d03a252 Mon Sep 17 00:00:00 2001 From: Bruno Haible Date: Sun, 20 Feb 2011 11:49:48 +0100 Subject: [PATCH 020/183] guile.m4: Add support for linking against guile with rpath. * guile.m4 (GUILE_FLAGS): Also set GUILE_LIBS and GUILE_LTLIBS. Fix documentation. --- meta/guile.m4 | 43 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 35 insertions(+), 8 deletions(-) diff --git a/meta/guile.m4 b/meta/guile.m4 index aaa9f8824..a7186fb84 100644 --- a/meta/guile.m4 +++ b/meta/guile.m4 @@ -70,29 +70,56 @@ AC_DEFUN([GUILE_PROGS], # # This macro runs the @code{guile-config} script, installed with Guile, to # find out where Guile's header files and libraries are installed. It sets -# two variables, @var{GUILE_CFLAGS} and @var{GUILE_LDFLAGS}. +# four variables, @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS}, +# and @var{GUILE_LTLIBS}. # # @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that -# uses Guile header files. This is almost always just a @code{-I} flag. +# uses Guile header files. This is almost always just one or more @code{-I} +# flags. # -# @var{GUILE_LDFLAGS}: flags to pass to the linker to link a program against +# @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program against # Guile. This includes @code{-lguile} for the Guile library itself, any # libraries that Guile itself requires (like -lqthreads), and so on. It may -# also include a @code{-L} flag to tell the compiler where to find the -# libraries. +# also include one or more @code{-L} flag to tell the compiler where to find +# the libraries. But it does not include flags that influence the program's +# runtime search path for libraries, and will therefore lead to a program +# that fails to start, unless all necessary libraries are installed in a +# standard location such as @file{/usr/lib}. +# +# @var{GUILE_LIBS} and @var{GUILE_LTLIBS}: flags to pass to the compiler or to +# libtool, respectively, to link a program against Guile. It includes flags +# that augment the program's runtime search path for libraries, so that shared +# libraries will be found at the location where they were during linking, even +# in non-standard locations. @var{GUILE_LIBS} is to be used when linking the +# program directly with the compiler, whereas @var{GUILE_LTLIBS} is to be used +# when linking the program is done through libtool. # # The variables are marked for substitution, as by @code{AC_SUBST}. # AC_DEFUN([GUILE_FLAGS], - [AC_REQUIRE([GUILE_PROGS])dnl + [dnl Find guile-config. + AC_REQUIRE([GUILE_PROGS])dnl + AC_MSG_CHECKING([libguile compile flags]) GUILE_CFLAGS="`$GUILE_CONFIG compile`" AC_MSG_RESULT([$GUILE_CFLAGS]) + AC_MSG_CHECKING([libguile link flags]) GUILE_LDFLAGS="`$GUILE_CONFIG link`" AC_MSG_RESULT([$GUILE_LDFLAGS]) - AC_SUBST(GUILE_CFLAGS) - AC_SUBST(GUILE_LDFLAGS) + + dnl Determine the platform dependent parameters needed to use rpath. + dnl AC_LIB_LINKFLAGS_FROM_LIBS is defined in gnulib/m4/lib-link.m4 and needs + dnl the file gnulib/build-aux/config.rpath. + AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LIBS], [$GUILE_LDFLAGS], []) + GUILE_LIBS="$GUILE_LDFLAGS $GUILE_LIBS" + AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LTLIBS], [$GUILE_LDFLAGS], [yes]) + GUILE_LTLIBS="$GUILE_LDFLAGS $GUILE_LTLIBS" + + AC_SUBST([GUILE_CFLAGS]) + AC_SUBST([GUILE_LDFLAGS]) + AC_SUBST([GUILE_LIBS]) + AC_SUBST([GUILE_LTLIBS]) ]) # GUILE_SITE_DIR -- find path to Guile "site" directory From 4b93693dffb2a4bd0d0da137b4d768ca3e68e8f1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 20 Feb 2011 13:15:34 +0100 Subject: [PATCH 021/183] @value{EFFECTIVE-VERSION} instead of 2.0 in some places in the manual * doc/ref/history.texi (A Timeline of Selected Guile Releases): Update the 2.0 release blurb. * doc/ref/api-foreign.texi (Modules and Extensions): * doc/ref/libguile-extensions.texi (A Sample Guile Extension): * doc/ref/tour.texi (Linking Guile into Programs): Use @value{EFFECTIVE-VERSION} instead of 2.0. Also fix sample extension compilation line to include the Guile CFLAGS. --- doc/ref/api-foreign.texi | 6 +++--- doc/ref/history.texi | 12 ++++++------ doc/ref/libguile-extensions.texi | 3 ++- doc/ref/tour.texi | 4 ++-- 4 files changed, 13 insertions(+), 12 deletions(-) diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index fa65d6821..e9d7df6eb 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -360,8 +360,8 @@ When loaded with @code{(use-modules (foo bar))}, the @code{load-extension} call looks for the @file{foobar-c-code.so} (etc) object file in Guile's @code{extensiondir}, which is usually a subdirectory of the @code{libdir}. For example, if your libdir is -@file{/usr/lib}, the @code{extensiondir} for the Guile 2.0.@var{x} -series will be @file{/usr/lib/guile/2.0/}. +@file{/usr/lib}, the @code{extensiondir} for the Guile @value{EFFECTIVE-VERSION}.@var{x} +series will be @file{/usr/lib/guile/@value{EFFECTIVE-VERSION}/}. The extension path includes the major and minor version of Guile (the ``effective version''), because Guile guarantees compatibility within a @@ -399,7 +399,7 @@ with the following in a @file{Makefile}, using @command{sed} @example foo.scm: foo.scm.in - sed 's|XXextensiondirXX|$(libdir)/guile/2.0|' foo.scm + sed 's|XXextensiondirXX|$(libdir)/guile/@value{EFFECTIVE-VERSION}|' foo.scm @end example The actual pattern @code{XXextensiondirXX} is arbitrary, it's only something diff --git a/doc/ref/history.texi b/doc/ref/history.texi index 62b637d81..970ec014b 100644 --- a/doc/ref/history.texi +++ b/doc/ref/history.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2008, 2010 +@c Copyright (C) 2008, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -214,15 +214,15 @@ user-space threading was removed in favor of POSIX pre-emptive threads, providing true multiprocessing. Gettext support was added, and Guile's C API was cleaned up and orthogonalized in a massive way. -@item 2.0 --- April 2010 +@item 2.0 --- 16 February 2010 A virtual machine was added to Guile, along with the associated compiler and toolchain. Support for internationalization was finally reimplemented, in terms of unicode, locales, and libunistring. Running Guile instances became controllable and debuggable from within Emacs, -via GDS and Geiser. Guile caught up to features found in a number of -other Schemes: SRFI-18 threads, including thread cancellation, -module-hygienic macros, a profiler, tracer, and debugger, SSAX XML -integration, bytevectors, module versions, and partial support for R6RS. +via Geiser. Guile caught up to features found in a number of other +Schemes: SRFI-18 threads, module-hygienic macros, a profiler, tracer, +and debugger, SSAX XML integration, bytevectors, a dynamic FFI, +delimited continuations, module versions, and partial support for R6RS. @end table @node Status diff --git a/doc/ref/libguile-extensions.texi b/doc/ref/libguile-extensions.texi index a5de72dd4..95f92cac6 100644 --- a/doc/ref/libguile-extensions.texi +++ b/doc/ref/libguile-extensions.texi @@ -78,7 +78,8 @@ This C source file needs to be compiled into a shared library. Here is how to do it on GNU/Linux: @smallexample -gcc -shared -o libguile-bessel.so -fPIC bessel.c +gcc `pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` \ + -shared -o libguile-bessel.so -fPIC bessel.c @end smallexample For creating shared libraries portably, we recommend the use of GNU diff --git a/doc/ref/tour.texi b/doc/ref/tour.texi index 2215cf034..312984683 100644 --- a/doc/ref/tour.texi +++ b/doc/ref/tour.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2010 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -115,7 +115,7 @@ can be compiled and linked like this: @example $ gcc -o simple-guile simple-guile.c \ - `pkg-config --cflags --libs guile-2.0` + `pkg-config --cflags --libs guile-@value{EFFECTIVE-VERSION}` @end example When it is run, it behaves just like the @code{guile} program except From f244cc515447f8fb7d2f10038e88636cf9cf5068 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 20 Feb 2011 15:01:37 +0100 Subject: [PATCH 022/183] tour.texi compilation fix * doc/ref/tour.texi (Writing Guile Extensions): Fix compilation example. --- doc/ref/tour.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/ref/tour.texi b/doc/ref/tour.texi index 312984683..c6949eb34 100644 --- a/doc/ref/tour.texi +++ b/doc/ref/tour.texi @@ -163,7 +163,8 @@ This C source file needs to be compiled into a shared library. Here is how to do it on GNU/Linux: @smallexample -gcc -shared -o libguile-bessel.so -fPIC bessel.c +gcc `pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` \ + -shared -o libguile-bessel.so -fPIC bessel.c @end smallexample For creating shared libraries portably, we recommend the use of GNU From 097a793b2225039980c2b6309661cb23326903f1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 20 Feb 2011 21:43:19 +0100 Subject: [PATCH 023/183] pkg-config instead of guile-config in manuals * doc/ref/api-options.texi (Build Config): * doc/ref/libguile-linking.texi (Linking Programs With Guile): (A Sample Guile Main Program): * doc/ref/libguile-smobs.texi (The Complete Example): Use pkg-config in the examples instead of guile-config. --- doc/ref/api-options.texi | 13 +++++++------ doc/ref/libguile-linking.texi | 32 ++++++++++++++++++++------------ doc/ref/libguile-smobs.texi | 8 ++++---- 3 files changed, 31 insertions(+), 22 deletions(-) diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi index 4813864e7..6f7568bee 100644 --- a/doc/ref/api-options.texi +++ b/doc/ref/api-options.texi @@ -171,13 +171,14 @@ guileversion, libguileinterface, buildstamp @end table Values are all strings. The value for @code{LIBS} is typically found -also as a part of "guile-config link" output. The value for +also as a part of @code{pkg-config --libs +guile-@value{EFFECTIVE-VERSION}} output. The value for @code{guileversion} has form X.Y.Z, and should be the same as returned -by @code{(version)}. The value for @code{libguileinterface} is -libtool compatible and has form CURRENT:REVISION:AGE -(@pxref{Versioning,, Library interface versions, libtool, GNU -Libtool}). The value for @code{buildstamp} is the output of the -command @samp{date -u +'%Y-%m-%d %T'} (UTC). +by @code{(version)}. The value for @code{libguileinterface} is libtool +compatible and has form CURRENT:REVISION:AGE (@pxref{Versioning,, +Library interface versions, libtool, GNU Libtool}). The value for +@code{buildstamp} is the output of the command @samp{date -u +'%Y-%m-%d +%T'} (UTC). In the source, @code{%guile-build-info} is initialized from libguile/libpath.h, which is completely generated, so deleting this file diff --git a/doc/ref/libguile-linking.texi b/doc/ref/libguile-linking.texi index b6a88556e..cc95ef423 100644 --- a/doc/ref/libguile-linking.texi +++ b/doc/ref/libguile-linking.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -16,16 +16,24 @@ head of any C source file that uses identifiers described in this manual. Once you've compiled your source files, you need to link them against the Guile object code library, @code{libguile}. -On most systems, you should not need to tell the compiler and linker -explicitly where they can find @file{libguile.h} and @file{libguile}. -When Guile has been installed in a peculiar way, or when you are on a -peculiar system, things might not be so easy and you might need to pass -additional @code{-I} or @code{-L} options to the compiler. Guile -provides the utility program @code{guile-config} to help you find the -right values for these options. You would typically run -@code{guile-config} during the configuration phase of your program and +@code{} is not in the default search path for headers, +because Guile supports parallel installation of multiple versions of +Guile, with each version's headers under their own directories. This is +to allow development against, say, both Guile 2.0 and 2.2. + +To compile code that includes @code{}, or links to +@code{libguile}, you need to select the effective version you are +interested in, and then ask @code{pkg-config} for the compilation flags +or linking instructions. For effective version +@value{EFFECTIVE-VERSION}, for example, you would invoke +@code{pkg-config --cflags --libs guile-@value{EFFECTIVE-VERSION}} to get +the compilation and linking flags necessary to link to version +@value{EFFECTIVE-VERSION} of Guile. You would typically run +@code{pkg-config} during the configuration phase of your program and use the obtained information in the Makefile. +See the @code{pkg-config} man page, for more information. + @menu * Guile Initialization Functions:: What to call first. * A Sample Guile Main Program:: Sources and makefiles. @@ -98,17 +106,17 @@ ready, it invokes @code{inner_main}, which calls @code{scm_shell} to process the command-line arguments in the usual way. Here is a Makefile which you can use to compile the above program. It -uses @code{guile-config} to learn about the necessary compiler and +uses @code{pkg-config} to learn about the necessary compiler and linker flags. @example # Use GCC, if you have it installed. CC=gcc # Tell the C compiler where to find -CFLAGS=`guile-config compile` +CFLAGS=`pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` # Tell the linker what libraries to use and where to find them. -LIBS=`guile-config link` +LIBS=`pkg-config --libs guile-@value{EFFECTIVE-VERSION}` simple-guile: simple-guile.o $@{CC@} simple-guile.o $@{LIBS@} -o simple-guile diff --git a/doc/ref/libguile-smobs.texi b/doc/ref/libguile-smobs.texi index c6581a1ac..eb938f099 100644 --- a/doc/ref/libguile-smobs.texi +++ b/doc/ref/libguile-smobs.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -686,9 +686,9 @@ Here is a sample build and interaction with the code from the @example zwingli:example-smob$ make CC=gcc -gcc `guile-config compile` -c image-type.c -o image-type.o -gcc `guile-config compile` -c myguile.c -o myguile.o -gcc image-type.o myguile.o `guile-config link` -o myguile +gcc `pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` -c image-type.c -o image-type.o +gcc `pkg-config --cflags guile-@value{EFFECTIVE-VERSION}` -c myguile.c -o myguile.o +gcc image-type.o myguile.o `pkg-config --libs guile-@value{EFFECTIVE-VERSION}` -o myguile zwingli:example-smob$ ./myguile guile> make-image # From 0e8a11c49a0ccc8d76807133e9abf82f8e14d1ec Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 20 Feb 2011 22:08:27 +0100 Subject: [PATCH 024/183] update examples in manual to use PKG_CHECK_MODULES * doc/ref/autoconf.texi (Using Autoconf Macros): Switch example to use PKG_CHECK_MODULES. * doc/ref/libguile-linking.texi (A Sample Guile Main Program): Likewise, and change from configure.in to configure.ac, and recommend autoreconf. --- doc/ref/autoconf.texi | 16 ++++++------- doc/ref/libguile-linking.texi | 45 +++++++++++++++++++---------------- 2 files changed, 33 insertions(+), 28 deletions(-) diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi index 1e334c0d1..6edee5425 100644 --- a/doc/ref/autoconf.texi +++ b/doc/ref/autoconf.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -97,25 +97,25 @@ to instantiate macros at top-level. We now include two examples, one simple and one complicated. -The first example is for a package that uses libguile, and thus needs to know -how to compile and link against it. So we use @code{GUILE_FLAGS} to set the -vars @code{GUILE_CFLAGS} and @code{GUILE_LDFLAGS}, which are automatically -substituted in the Makefile. +The first example is for a package that uses libguile, and thus needs to +know how to compile and link against it. So we use +@code{PKG_CHECK_MODULES} to set the vars @code{GUILE_CFLAGS} and +@code{GUILE_LIBS}, which are automatically substituted in the Makefile. @example In configure.ac: - GUILE_FLAGS + PKG_CHECK_MODULES([GUILE], [guile-@value{EFFECTIVE-VERSION}]) In Makefile.in: GUILE_CFLAGS = @@GUILE_CFLAGS@@ - GUILE_LDFLAGS = @@GUILE_LDFLAGS@@ + GUILE_LIBS = @@GUILE_LIBS@@ myprog.o: myprog.c $(CC) -o $@ $(GUILE_CFLAGS) $< myprog: myprog.o - $(CC) -o $@ $< $(GUILE_LDFLAGS) + $(CC) -o $@ $< $(GUILE_LIBS) @end example The second example is for a package of Guile Scheme modules that uses an diff --git a/doc/ref/libguile-linking.texi b/doc/ref/libguile-linking.texi index cc95ef423..3a90208be 100644 --- a/doc/ref/libguile-linking.texi +++ b/doc/ref/libguile-linking.texi @@ -128,13 +128,11 @@ simple-guile.o: simple-guile.c If you are using the GNU Autoconf package to make your application more portable, Autoconf will settle many of the details in the Makefile above automatically, making it much simpler and more portable; we recommend -using Autoconf with Guile. Guile also provides the @code{GUILE_FLAGS} -macro for autoconf that performs all necessary checks. Here is a -@file{configure.in} file for @code{simple-guile} that uses this macro. -Autoconf can use this file as a template to generate a @code{configure} -script. In order for Autoconf to find the @code{GUILE_FLAGS} macro, you -will need to run @code{aclocal} first (@pxref{Invoking aclocal,,, -automake, GNU Automake}). +using Autoconf with Guile. Here is a @file{configure.ac} file for +@code{simple-guile} that uses the standard @code{PKG_CHECK_MODULES} +macro to check for Guile. Autoconf will process this file into a +@code{configure} script. We recommend invoking Autoconf via the +@code{autoreconf} utility. @example AC_INIT(simple-guile.c) @@ -143,19 +141,21 @@ AC_INIT(simple-guile.c) AC_PROG_CC # Check for Guile -GUILE_FLAGS +PKG_CHECK_MODULES([GUILE], [guile-@value{EFFECTIVE-VERSION}]) # Generate a Makefile, based on the results. AC_OUTPUT(Makefile) @end example +Run @code{autoreconf -vif} to generate @code{configure}. + Here is a @code{Makefile.in} template, from which the @code{configure} script produces a Makefile customized for the host system: @example # The configure script fills in these values. CC=@@CC@@ CFLAGS=@@GUILE_CFLAGS@@ -LIBS=@@GUILE_LDFLAGS@@ +LIBS=@@GUILE_LIBS@@ simple-guile: simple-guile.o $@{CC@} simple-guile.o $@{LIBS@} -o simple-guile @@ -164,23 +164,28 @@ simple-guile.o: simple-guile.c @end example The developer should use Autoconf to generate the @file{configure} -script from the @file{configure.in} template, and distribute +script from the @file{configure.ac} template, and distribute @file{configure} with the application. Here's how a user might go about building the application: @example $ ls -Makefile.in configure* configure.in simple-guile.c +Makefile.in configure* configure.ac simple-guile.c $ ./configure -creating cache ./config.cache -checking for gcc... (cached) gcc -checking whether the C compiler (gcc ) works... yes -checking whether the C compiler (gcc ) is a cross-compiler... no -checking whether we are using GNU C... (cached) yes -checking whether gcc accepts -g... (cached) yes -checking for Guile... yes -creating ./config.status -creating Makefile +checking for gcc... ccache gcc +checking whether the C compiler works... yes +checking for C compiler default output file name... a.out +checking for suffix of executables... +checking whether we are cross compiling... no +checking for suffix of object files... o +checking whether we are using the GNU C compiler... yes +checking whether ccache gcc accepts -g... yes +checking for ccache gcc option to accept ISO C89... none needed +checking for pkg-config... /usr/bin/pkg-config +checking pkg-config is at least version 0.9.0... yes +checking for GUILE... yes +configure: creating ./config.status +config.status: creating Makefile $ make [...] $ ./simple-guile From 630b6588b7b26bf96874b235ff43ee4c3974cce3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Feb 2011 00:32:13 +0100 Subject: [PATCH 025/183] Make `(rnrs base)' independent of other rnrs modules. * module/rnrs/base.scm (define-proxy): New macro. (raise, condition, make-error, make-assertion-violation, make-who-condition, make-message-condition, make-irritants-condition): Use it. --- module/rnrs/base.scm | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index 4c9c51bb0..2f5a218de 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -123,24 +123,33 @@ (define (vector-map proc . vecs) (list->vector (apply map (cons proc (map vector->list vecs))))) - (define-syntax raise - ;; Resolve the real `raise' lazily to avoid a circular dependency - ;; between `(rnrs base)' and `(rnrs exceptions)'. - (syntax-rules () - ((_ c) - ((@ (rnrs exceptions) raise) c)))) + (define-syntax define-proxy + (syntax-rules (@) + ;; Define BINDING to point to (@ MODULE ORIGINAL). This hack is to + ;; make sure MODULE is loaded lazily, at run-time, when BINDING is + ;; encountered, rather than being loaded while compiling and + ;; loading (rnrs base). + ;; This avoids circular dependencies among modules and makes + ;; (rnrs base) more lightweight. + ((_ binding (@ module original)) + (define-syntax binding + (identifier-syntax + (module-ref (resolve-interface 'module) 'original)))))) - (define condition + (define-proxy raise + (@ (rnrs exceptions) raise)) + + (define-proxy condition (@ (rnrs conditions) condition)) - (define make-error + (define-proxy make-error (@ (rnrs conditions) make-error)) - (define make-assertion-violation + (define-proxy make-assertion-violation (@ (rnrs conditions) make-assertion-violation)) - (define make-who-condition + (define-proxy make-who-condition (@ (rnrs conditions) make-who-condition)) - (define make-message-condition + (define-proxy make-message-condition (@ (rnrs conditions) make-message-condition)) - (define make-irritants-condition + (define-proxy make-irritants-condition (@ (rnrs conditions) make-irritants-condition)) (define (error who message . irritants) From 9d798af739a6b3a1fa66c19bc5864bdd57e8d5b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Feb 2011 00:05:05 +0100 Subject: [PATCH 026/183] Compile `(rnrs)' after all other RNRS modules, potentially. * module/Makefile.am (RNRS_SOURCES): Move `rnrs.scm' last. --- module/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/module/Makefile.am b/module/Makefile.am index c0f68864f..16ce6d214 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -269,7 +269,6 @@ SRFI_SOURCES = \ srfi/srfi-98.scm RNRS_SOURCES = \ - rnrs.scm \ rnrs/base.scm \ rnrs/conditions.scm \ rnrs/control.scm \ @@ -294,7 +293,8 @@ RNRS_SOURCES = \ rnrs/io/ports.scm \ rnrs/records/inspection.scm \ rnrs/records/procedural.scm \ - rnrs/records/syntactic.scm + rnrs/records/syntactic.scm \ + rnrs.scm EXTRA_DIST += scripts/ChangeLog-2008 EXTRA_DIST += scripts/README From 8bc5b79df78aeefa8fc15b040deb43fb14846d26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Feb 2011 00:07:48 +0100 Subject: [PATCH 027/183] Add omitted exports from `(ice-9 vlist)'. * module/ice-9/vlist.scm: Export `vhash-delq' and `vhash-delv'. --- module/ice-9/vlist.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm index 5ea09362c..cd1b9b846 100644 --- a/module/ice-9/vlist.scm +++ b/module/ice-9/vlist.scm @@ -1,6 +1,6 @@ ;;; -*- mode: scheme; coding: utf-8; -*- ;;; -;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -32,7 +32,8 @@ vhash? vhash-cons vhash-consq vhash-consv vhash-assoc vhash-assq vhash-assv - vhash-delete vhash-fold + vhash-delete vhash-delq vhash-delv + vhash-fold vhash-fold* vhash-foldq* vhash-foldv* alist->vhash)) From 2a39def1a8f9dc814083f51acc3dd8a5819afeff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Feb 2011 00:08:39 +0100 Subject: [PATCH 028/183] Optimize `vhash-delete'. * module/ice-9/vlist.scm (vhash-delete): Check whether KEY is in VHASH and return VHASH if it's not. --- module/ice-9/vlist.scm | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm index cd1b9b846..6c88df86a 100644 --- a/module/ice-9/vlist.scm +++ b/module/ice-9/vlist.scm @@ -530,14 +530,16 @@ value of @var{result} for the first call to @var{proc}." (define* (vhash-delete key vhash #:optional (equal? equal?) (hash hash)) "Remove all associations from @var{vhash} with @var{key}, comparing keys with @var{equal?}." - (vlist-fold (lambda (k+v result) - (let ((k (car k+v)) - (v (cdr k+v))) - (if (equal? k key) - result - (vhash-cons k v result)))) - vlist-null - vhash)) + (if (vhash-assoc key vhash equal? hash) + (vlist-fold (lambda (k+v result) + (let ((k (car k+v)) + (v (cdr k+v))) + (if (equal? k key) + result + (vhash-cons k v result)))) + vlist-null + vhash) + vhash)) (define vhash-delq (cut vhash-delete <> <> eq? hashq)) (define vhash-delv (cut vhash-delete <> <> eqv? hashv)) From 1e1808c920fb0defe75850af26fae199e1090384 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Feb 2011 00:31:00 +0100 Subject: [PATCH 029/183] Use `vhash-delq' in `(language tree-il analyze)'. * module/language/tree-il/analyze.scm (unbound-variable-analysis): Use `vhash-delq' instead of `vhash-delete'. --- module/language/tree-il/analyze.scm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 745ce3907..60a5bcddd 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -1,6 +1,6 @@ ;;; TREE-IL -> GLIL compiler -;; Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -926,7 +926,7 @@ accurate information is missing from a given `tree-il' element." (make-toplevel-info (vhash-consq name src refs) defs)))) (( name) - (make-toplevel-info (vhash-delete name refs eq?) + (make-toplevel-info (vhash-delq name refs) (vhash-consq name #t defs))) (( proc args) @@ -935,8 +935,7 @@ accurate information is missing from a given `tree-il' element." (let ((name (goops-toplevel-definition proc args env))) (if (symbol? name) - (make-toplevel-info (vhash-delete name refs - eq?) + (make-toplevel-info (vhash-delq name refs) (vhash-consq name #t defs)) (make-toplevel-info refs defs)))) (else From da0c22b5d307752770eec9ad218f018d55d403d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Feb 2011 00:32:00 +0100 Subject: [PATCH 030/183] Fix a bug in `vhash-delete'. * module/ice-9/vlist.scm (vhash-delete): Honor HASH. * test-suite/tests/vlist.test ("vhash")["vhash-delete honors HASH"]: New test. --- module/ice-9/vlist.scm | 2 +- test-suite/tests/vlist.test | 14 +++++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm index 6c88df86a..34c7c00c1 100644 --- a/module/ice-9/vlist.scm +++ b/module/ice-9/vlist.scm @@ -536,7 +536,7 @@ with @var{equal?}." (v (cdr k+v))) (if (equal? k key) result - (vhash-cons k v result)))) + (vhash-cons k v result hash)))) vlist-null vhash) vhash)) diff --git a/test-suite/tests/vlist.test b/test-suite/tests/vlist.test index f3e0989c1..b590bbda1 100644 --- a/test-suite/tests/vlist.test +++ b/test-suite/tests/vlist.test @@ -2,7 +2,7 @@ ;;;; ;;;; Ludovic Courtès ;;;; -;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -282,6 +282,18 @@ #t keys))))) + (pass-if "vhash-delete honors HASH" + ;; In 2.0.0, `vhash-delete' would construct a new vhash without + ;; using the supplied hash procedure, which could lead to + ;; inconsistencies. + (let* ((s "hello") + (vh (fold vhash-consq + (vhash-consq s "world" vlist-null) + (iota 300) + (iota 300)))) + (and (vhash-assq s vh) + (pair? (vhash-assq s (vhash-delete 123 vh eq? hashq)))))) + (pass-if "vhash-fold" (let* ((keys '(a b c d e f g d h i)) (values '(1 2 3 4 5 6 7 0 8 9)) From 85bdb6ac9c8893b88c8d71a8864f019f1127eba3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 15 Feb 2011 19:29:41 -0500 Subject: [PATCH 031/183] Portability fix for new log and log10 * libguile/numbers.c: Define M_LN2 if it's not already defined. Fix error in comment. --- libguile/numbers.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index d0aacb7c4..b8cfa5dc9 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -72,6 +72,9 @@ #ifndef M_LOG10E #define M_LOG10E 0.43429448190325182765 #endif +#ifndef M_LN2 +#define M_LN2 0.69314718055994530942 +#endif #ifndef M_PI #define M_PI 3.14159265358979323846 #endif @@ -9399,7 +9402,7 @@ log_of_exact_integer_with_size (SCM n, long size) return log_of_shifted_double (scm_to_double (n), 0); } -/* Returns log(n), for exact integer n of integer-length size */ +/* Returns log(n), for exact integer n */ static SCM log_of_exact_integer (SCM n) { From 40d2a0076af69c3227bc13606aebdb5822ed7f0d Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 23 Feb 2011 11:59:38 +0100 Subject: [PATCH 032/183] GC dead links in weak hash tables before a possible rehash * libguile/hashtab.c (vacuum_weak_hash_table): New helper, goes through the entirety of a weak hash table, vacuuming dead entries. (scm_hash_fn_create_handle_x): If when adding to a weak hash table, we would trigger a rehash, vacuum the table first. The weak_bucket_assoc would have only caught dead entries within one bucket. Without this patch, the following code leaks: (let lp () (call-with-output-string (lambda (port) (display "foo" port))) (lp)) --- libguile/hashtab.c | 34 +++++++++++++++++++++++++++++----- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/libguile/hashtab.c b/libguile/hashtab.c index f3887c213..c703108cf 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -120,6 +120,26 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items) return result; } +static void +vacuum_weak_hash_table (SCM table) +{ + SCM buckets = SCM_HASHTABLE_VECTOR (table); + unsigned long k = SCM_SIMPLE_VECTOR_LENGTH (buckets); + size_t len = SCM_HASHTABLE_N_ITEMS (table); + + while (k--) + { + size_t removed; + SCM alist = SCM_SIMPLE_VECTOR_REF (buckets, k); + alist = scm_fixup_weak_alist (alist, &removed); + assert (removed <= len); + len -= removed; + SCM_SIMPLE_VECTOR_SET (buckets, k, alist); + } + + SCM_SET_HASHTABLE_N_ITEMS (table, len); +} + /* Packed arguments for `do_weak_bucket_fixup'. */ struct t_fixup_args @@ -651,12 +671,16 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, } SCM_SETCDR (new_bucket, SCM_SIMPLE_VECTOR_REF (buckets, k)); SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket); - /* Update element count and maybe rehash the table. The - table might have too few entries here since weak hash - tables used with the hashx_* functions can not be - rehashed after GC. - */ SCM_HASHTABLE_INCREMENT (table); + + /* Maybe rehash the table. If it's a weak table, pump all of the + buckets first to remove stale links. If the weak table is of + the kind that gets lots of insertions of short-lived values, we + might never need to actually rehash. */ + if (SCM_HASHTABLE_WEAK_P (table) + && SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) + vacuum_weak_hash_table (table); + if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table) || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) scm_i_rehash (table, hash_fn, closure, FUNC_NAME); From 4a2ac0623c3dabb2c8b9d38c27b837dcb2c7fe4e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 23 Feb 2011 21:04:26 +0100 Subject: [PATCH 033/183] open-pipe* pumps pipes guardian * module/ice-9/popen.scm (open-pipe*): Hack around the lack of an after-gc hook, and pump the pipes guardian here in the procedure that adds to the guardian. --- module/ice-9/popen.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index c5b02f7f1..5445ecb6b 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -1,6 +1,6 @@ ;; popen emulation, for non-stdio based ports. -;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -139,6 +139,10 @@ A port to the process (based on pipes) is created and returned. @var{modes} specifies whether an input, an output or an input-output port to the process is created: it should be the value of @code{OPEN_READ}, @code{OPEN_WRITE} or @code{OPEN_BOTH}." + + ;; Until we get GC hooks working again, pump the guardian here. + (reap-pipes) + (let* ((port/pid (apply open-process mode command args)) (port (car port/pid))) (pipe-guardian port) From a964aa62c273d93fad61ae67abd98027e1d142d3 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Feb 2011 11:10:19 +0100 Subject: [PATCH 034/183] web server more assiduous about closing ports * module/web/uri.scm: * module/web/server.scm (call-with-output-string*): (call-with-output-bytevector*): Local procs to output to strings or bytevectors, *and then close the port*. We can't make this change in call-with-output-string because it would be incompatible. * module/web/uri.scm (call-with-encoded-output-string, decode-string) (uri-decode) * module/web/server.scm (call-with-encoded-output-string): Use the new helpers. --- module/web/server.scm | 31 ++++++++++---- module/web/uri.scm | 99 ++++++++++++++++++++++++++----------------- 2 files changed, 82 insertions(+), 48 deletions(-) diff --git a/module/web/server.scm b/module/web/server.scm index 8dbd13961..c5e623a19 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -167,18 +167,33 @@ values." (warn "Error while accepting client" k args) (values #f #f #f)))) +;; like call-with-output-string, but actually closes the port (doh) +(define (call-with-output-string* proc) + (let ((port (open-output-string))) + (proc port) + (let ((str (get-output-string port))) + (close-port port) + str))) + +(define (call-with-output-bytevector* proc) + (call-with-values + (lambda () + (open-bytevector-output-port)) + (lambda (port get-bytevector) + (proc port) + (let ((bv (get-bytevector))) + (close-port port) + bv)))) + (define (call-with-encoded-output-string charset proc) (if (string-ci=? charset "utf-8") ;; I don't know why, but this appears to be faster; at least for ;; examples/debug-sxml.scm (1464 reqs/s versus 850 reqs/s). - (string->utf8 (call-with-output-string proc)) - (call-with-values - (lambda () - (open-bytevector-output-port)) - (lambda (port get-bytevector) - (set-port-encoding! port charset) - (proc port) - (get-bytevector))))) + (string->utf8 (call-with-output-string* proc)) + (call-with-output-bytevector* + (lambda (port) + (set-port-encoding! port charset) + (proc port))))) (define (encode-string str charset) (if (string-ci=? charset "utf-8") diff --git a/module/web/uri.scm b/module/web/uri.scm index 23699e921..6f9377c19 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -1,6 +1,6 @@ ;;;; (web uri) --- URI manipulation tools ;;;; -;;;; Copyright (C) 1997,2001,2002,2010 Free Software Foundation, Inc. +;;;; Copyright (C) 1997,2001,2002,2010,2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -227,16 +227,31 @@ printed." "")))) +;; like call-with-output-string, but actually closes the port (doh) +(define (call-with-output-string* proc) + (let ((port (open-output-string))) + (proc port) + (let ((str (get-output-string port))) + (close-port port) + str))) + +(define (call-with-output-bytevector* proc) + (call-with-values + (lambda () + (open-bytevector-output-port)) + (lambda (port get-bytevector) + (proc port) + (let ((bv (get-bytevector))) + (close-port port) + bv)))) + (define (call-with-encoded-output-string encoding proc) (if (string-ci=? encoding "utf-8") - (string->utf8 (call-with-output-string proc)) - (call-with-values - (lambda () - (open-bytevector-output-port)) - (lambda (port get-bytevector) - (set-port-encoding! port encoding) - (proc port) - (get-bytevector))))) + (string->utf8 (call-with-output-string* proc)) + (call-with-output-bytevector* + (lambda (port) + (set-port-encoding! port encoding) + (proc port))))) (define (encode-string str encoding) (if (string-ci=? encoding "utf-8") @@ -250,7 +265,9 @@ printed." (utf8->string bv) (let ((p (open-bytevector-input-port bv))) (set-port-encoding! p encoding) - (read-delimited "" p)))) + (let ((res (read-delimited "" p))) + (close-port p) + res)))) ;; A note on characters and bytes: URIs are defined to be sequences of @@ -279,35 +296,37 @@ There is no guarantee that a given byte sequence is a valid string encoding. Therefore this routine may signal an error if the decoded bytes are not valid for the given encoding. Pass @code{#f} for @var{encoding} if you want decoded bytes as a bytevector directly." - (let ((len (string-length str))) - (call-with-values open-bytevector-output-port - (lambda (port get-bytevector) - (let lp ((i 0)) - (if (= i len) - (if encoding - (decode-string (get-bytevector) encoding) - (get-bytevector)) ; raw bytevector - (let ((ch (string-ref str i))) - (cond - ((eqv? ch #\+) - (put-u8 port (char->integer #\space)) - (lp (1+ i))) - ((and (< (+ i 2) len) (eqv? ch #\%) - (let ((a (string-ref str (+ i 1))) - (b (string-ref str (+ i 2)))) - (and (char-set-contains? hex-chars a) - (char-set-contains? hex-chars b) - (string->number (string a b) 16)))) - => (lambda (u8) - (put-u8 port u8) - (lp (+ i 3)))) - ((< (char->integer ch) 128) - (put-u8 port (char->integer ch)) - (lp (1+ i))) - (else - (uri-error "Invalid character in encoded URI ~a: ~s" - str ch)))))))))) - + (let* ((len (string-length str)) + (bv + (call-with-output-bytevector* + (lambda (port) + (let lp ((i 0)) + (if (< i len) + (let ((ch (string-ref str i))) + (cond + ((eqv? ch #\+) + (put-u8 port (char->integer #\space)) + (lp (1+ i))) + ((and (< (+ i 2) len) (eqv? ch #\%) + (let ((a (string-ref str (+ i 1))) + (b (string-ref str (+ i 2)))) + (and (char-set-contains? hex-chars a) + (char-set-contains? hex-chars b) + (string->number (string a b) 16)))) + => (lambda (u8) + (put-u8 port u8) + (lp (+ i 3)))) + ((< (char->integer ch) 128) + (put-u8 port (char->integer ch)) + (lp (1+ i))) + (else + (uri-error "Invalid character in encoded URI ~a: ~s" + str ch)))))))))) + (if encoding + (decode-string bv encoding) + ;; Otherwise return raw bytevector + bv))) + (define ascii-alnum-chars (string->char-set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")) @@ -337,7 +356,7 @@ within the given @var{encoding}, then encodes each byte as @code{%@var{HH}}, where @var{HH} is the hexadecimal representation of the byte." (if (string-index str unescaped-chars) - (call-with-output-string + (call-with-output-string* (lambda (port) (string-for-each (lambda (ch) From b2548e23445d44f9b6f0b21d07c0ee94c83d0607 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Feb 2011 13:10:16 +0100 Subject: [PATCH 035/183] errno saving in display_string * libguile/print.c (display_string): Fix a case in which perhaps `errno' could have been stompled. --- libguile/print.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libguile/print.c b/libguile/print.c index 59b109380..3855146b1 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -862,6 +862,8 @@ display_string (const void *str, int narrow_p, if (SCM_UNLIKELY (done == (size_t) -1)) { + int errno_save = errno; + /* Reset the `iconv' state. */ iconv (pt->output_cd, NULL, NULL, NULL, NULL); @@ -873,7 +875,7 @@ display_string (const void *str, int narrow_p, codepoints_read = offsets[input - utf8_buf] - printed; printed += codepoints_read; - if (errno == EILSEQ && + if (errno_save == EILSEQ && strategy != SCM_FAILED_CONVERSION_ERROR) { /* Conversion failed somewhere in INPUT and we want to From 574b7be0ba5dbbecfacf172ed81a5f22d1d5566e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Feb 2011 13:12:58 +0100 Subject: [PATCH 036/183] pointerless backing buffers for string ports * libguile/strports.c (scm_mkstrport): String port string buffer allocated atomically. --- libguile/strports.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index 625b75308..64987fabc 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -314,7 +314,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) /* Create a copy of STR in the encoding of Z. */ buf = scm_to_stringn (str, &str_len, pt->encoding, SCM_FAILED_CONVERSION_ERROR); - c_str = scm_gc_malloc (str_len, "strport"); + c_str = scm_gc_malloc_pointerless (str_len, "strport"); memcpy (c_str, buf, str_len); free (buf); From ec7f624d652eaf6e4cf06253101b4a986e1b9e8e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Feb 2011 16:30:08 +0100 Subject: [PATCH 037/183] re-enable the after-gc-hook * libguile/gc.c (scm_gc): No need to take a mutex here. Don't run the hook, the hook will run itself. (scm_c_register_gc_callback): New private helper, registers a callback the next time GC happens. (system_gc_callback): Guile's internal callback that runs scm_after_gc_c_hook, which itself queues a call to the after-gc-hook. (scm_storage_prehistory): Queue up a call to system_gc_callback. --- libguile/gc.c | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/libguile/gc.c b/libguile/gc.c index 91250ba57..f2c0179ca 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -69,10 +69,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include #endif -/* Lock this mutex before doing lazy sweeping. - */ -scm_i_pthread_mutex_t scm_i_sweep_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; - /* Set this to != 0 if every cell that is accessed shall be checked: */ int scm_debug_cell_accesses_p = 0; @@ -377,17 +373,7 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0, "no longer accessible.") #define FUNC_NAME s_scm_gc { - scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex); scm_i_gc ("call"); - /* njrev: It looks as though other places, e.g. scm_realloc, - can call scm_i_gc without acquiring the sweep mutex. Does this - matter? Also scm_i_gc (or its descendants) touch the - scm_sys_protects, which are protected in some cases - (e.g. scm_permobjs above in scm_gc_stats) by a critical section, - not by the sweep mutex. Shouldn't all the GC-relevant objects be - protected in the same way? */ - scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex); - scm_c_hook_run (&scm_after_gc_c_hook, 0); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -587,6 +573,23 @@ scm_gc_unregister_roots (SCM *b, unsigned long n) scm_gc_unregister_root (p); } +static void +scm_c_register_gc_callback (void *key, void (*func) (void *, void *), + void *data) +{ + if (!key) + key = GC_MALLOC_ATOMIC (sizeof (void*)); + + GC_REGISTER_FINALIZER_NO_ORDER (key, func, data, NULL, NULL); +} + +static void +system_gc_callback (void *key, void *data) +{ + scm_c_register_gc_callback (key, system_gc_callback, data); + scm_c_hook_run (&scm_after_gc_c_hook, NULL); +} + @@ -642,6 +645,8 @@ scm_storage_prehistory () scm_c_hook_init (&scm_before_sweep_c_hook, 0, SCM_C_HOOK_NORMAL); scm_c_hook_init (&scm_after_sweep_c_hook, 0, SCM_C_HOOK_NORMAL); scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL); + + scm_c_register_gc_callback (NULL, system_gc_callback, NULL); } scm_i_pthread_mutex_t scm_i_gc_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; From 62c290e977ea71c8dcb9ccb45e5a06d9e5a13a40 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Feb 2011 17:00:30 +0100 Subject: [PATCH 038/183] weak hash tables vacuum stale entries after a gc * libguile/hashtab.c (scm_c_register_weak_gc_callback): New private helper, arranges for a C function to be called with a SCM as an argument, as long as the argument is reachable by GC. (scm_make_weak_key_hash_table) (scm_make_weak_value_hash_table) (scm_make_doubly_weak_hash_table): Register a weak GC callback to vacuum_weak_hash_table. --- libguile/hashtab.c | 70 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 49 insertions(+), 21 deletions(-) diff --git a/libguile/hashtab.c b/libguile/hashtab.c index c703108cf..4c4c10691 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -33,6 +33,7 @@ #include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/ports.h" +#include "libguile/bdw-gc.h" #include "libguile/validate.h" #include "libguile/hashtab.h" @@ -417,6 +418,34 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0, } #undef FUNC_NAME +static void +weak_gc_callback (void *ptr, void *data) +{ + void **weak = ptr; + void *val = *weak; + + if (val) + { + void (*callback) (SCM) = data; + + GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_callback, data, NULL, NULL); + + callback (PTR2SCM (val)); + } +} + +static void +scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM)) +{ + void **weak = GC_MALLOC_ATOMIC (sizeof (void**)); + + *weak = SCM2PTR (obj); + GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj)); + + GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_callback, (void*)callback, + NULL, NULL); +} + SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0, (SCM n), "@deffnx {Scheme Procedure} make-weak-value-hash-table size\n" @@ -442,13 +471,17 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 0, 1, "(@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_weak_value_hash_table { + SCM ret; + if (SCM_UNBNDP (n)) - return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME); else - { - return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, - scm_to_ulong (n), FUNC_NAME); - } + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR, + scm_to_ulong (n), FUNC_NAME); + + scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table); + + return ret; } #undef FUNC_NAME @@ -459,16 +492,18 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0 "buckets. (@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_doubly_weak_hash_table { + SCM ret; + if (SCM_UNBNDP (n)) - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, - 0, - FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, + 0, FUNC_NAME); else - { - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, - scm_to_ulong (n), - FUNC_NAME); - } + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR, + scm_to_ulong (n), FUNC_NAME); + + scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table); + + return ret; } #undef FUNC_NAME @@ -673,14 +708,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket); SCM_HASHTABLE_INCREMENT (table); - /* Maybe rehash the table. If it's a weak table, pump all of the - buckets first to remove stale links. If the weak table is of - the kind that gets lots of insertions of short-lived values, we - might never need to actually rehash. */ - if (SCM_HASHTABLE_WEAK_P (table) - && SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) - vacuum_weak_hash_table (table); - + /* Maybe rehash the table. */ if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table) || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) scm_i_rehash (table, hash_fn, closure, FUNC_NAME); From cfad56a4449011e34aa917136cb6844ef453edcc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 24 Feb 2011 23:13:54 +0100 Subject: [PATCH 039/183] Fix README. * README: Remove mention of an alpha release. Reported by Mark H. Weaver. --- README | 22 +++++----------------- 1 file changed, 5 insertions(+), 17 deletions(-) diff --git a/README b/README index 1e9c2f8cd..256b7d0d6 100644 --- a/README +++ b/README @@ -1,20 +1,8 @@ -!!! This is not a Guile release; it is a source tree retrieved via -Git or as a nightly snapshot at some random time after the -Guile 1.8 release. If this were a Guile release, you would not see -this message. !!! [fixme: zonk on release] - -This is a 1.9 development version of Guile, Project GNU's extension -language library. Guile is an interpreter for Scheme, packaged as a -library that you can link into your applications to give them their -own scripting language. Guile will eventually support other languages -as well, giving users of Guile-based applications a choice of -languages. - -Guile versions with an odd middle number, i.e. 1.9.* are unstable -development versions. Even middle numbers indicate stable versions. -This has been the case since the 1.3.* series. - -The next stable release will likely be version 2.0.0. +This is version 2.0 of Guile, Project GNU's extension language library. +Guile is an implementation of the Scheme programming language, packaged +as a library that can be linked into applications to give them their own +extension language. Guile supports other languages as well, giving +users of Guile-based applications a choice of languages. Please send bug reports to bug-guile@gnu.org. From 914c4300b2e6857152363529706799ae692bc2a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 24 Feb 2011 23:17:06 +0100 Subject: [PATCH 040/183] Make `locale-digit-grouping' more robust. * libguile/i18n.c (scm_nl_langinfo)[GROUPING]: Consider negative numbers like `CHAR_MAX'. Reported by David Fang . Fix suggested by Bruno Haible . --- libguile/i18n.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/libguile/i18n.c b/libguile/i18n.c index 14dc9b985..c51df4a2c 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1564,11 +1564,14 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0, { char *p; - /* In this cases, the result is to be interpreted as a list of - numbers. If the last item is `CHARS_MAX', it has the special - meaning "no more grouping". */ + /* In this cases, the result is to be interpreted as a list + of numbers. If the last item is `CHAR_MAX' or a negative + number, it has the special meaning "no more grouping" + (negative numbers aren't specified in POSIX but can be + used by glibc; see + ). */ result = SCM_EOL; - for (p = c_result; (*p != '\0') && (*p != CHAR_MAX); p++) + for (p = c_result; (*p > 0) && (*p != CHAR_MAX); p++) result = scm_cons (SCM_I_MAKINUM ((int) *p), result); { @@ -1576,7 +1579,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0, result = scm_reverse_x (result, SCM_EOL); - if (*p != CHAR_MAX) + if (*p == 0) { /* Cyclic grouping information. */ if (last_pair != SCM_EOL) From 080a9d4f564c1b4e2171aa35a2a50fe20c300ecd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 24 Feb 2011 23:17:23 +0100 Subject: [PATCH 041/183] Revert ""latin1" -> "Latin-1"." This reverts commit c2c550ca9d2442d070f79ed8bacb8db173c72df3. The name "latin1" is standardized by IANA, unlike the other one. Reported by Bruno Haible. --- doc/ref/vm.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi index fa73f9b2e..0a1425026 100644 --- a/doc/ref/vm.texi +++ b/doc/ref/vm.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2008, 2009, 2010, 2011 +@c Copyright (C) 2008,2009,2010 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -1063,7 +1063,7 @@ embedded in the stream as a string. @end deffn @deffn Instruction load-string length Load a string from the instruction stream. The string is assumed to be -Latin-1-encoded. +encoded in the ``latin1'' locale. @end deffn @deffn Instruction load-wide-string length Load a UTF-32 string from the instruction stream. @var{length} is the @@ -1071,7 +1071,7 @@ length in bytes, not in codepoints. @end deffn @deffn Instruction load-symbol length Load a symbol from the instruction stream. The symbol is assumed to be -Latin-1-encoded. Symbols backed by wide strings may +encoded in the ``latin1'' locale. Symbols backed by wide strings may be loaded via @code{load-wide-string} then @code{make-symbol}. @end deffn @deffn Instruction load-array length From 6800f86d63c4953fe705f6f74e252fb2bd9cc8c8 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 25 Feb 2011 10:48:35 +0100 Subject: [PATCH 042/183] make-weak-key-hash-table vacuuming * libguile/hashtab.c (scm_make_weak_key_hash_table): Whoops, fix the case I actually cared about. --- libguile/hashtab.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 4c4c10691..a76c03812 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -456,11 +456,17 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0, "would modify regular hash tables. (@pxref{Hash Tables})") #define FUNC_NAME s_scm_make_weak_key_hash_table { + SCM ret; + if (SCM_UNBNDP (n)) - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR, 0, FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR, 0, FUNC_NAME); else - return make_hash_table (SCM_HASHTABLEF_WEAK_CAR, - scm_to_ulong (n), FUNC_NAME); + ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR, + scm_to_ulong (n), FUNC_NAME); + + scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table); + + return ret; } #undef FUNC_NAME From 249f2788c6c9d6c0ddfbca37c8a6bfab42b22374 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 25 Feb 2011 14:54:36 +0100 Subject: [PATCH 043/183] Fix `gc-profile.scm'. * gc-benchmarks/gc-profile.scm (memory-mappings)[mapping-line-rx]: Fix and give an example. (total-heap-size): Fix docstring. --- gc-benchmarks/gc-profile.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/gc-benchmarks/gc-profile.scm b/gc-benchmarks/gc-profile.scm index 3365832a0..667886ea5 100755 --- a/gc-benchmarks/gc-profile.scm +++ b/gc-benchmarks/gc-profile.scm @@ -3,7 +3,7 @@ exec ${GUILE-guile} --no-debug -q -l "$0" \ -c '(apply main (cdr (command-line)))' "$@" !# -;;; Copyright (C) 2008 Free Software Foundation, Inc. +;;; Copyright (C) 2008, 2011 Free Software Foundation, Inc. ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public License @@ -38,8 +38,10 @@ memory mapping of process @var{pid}. This information is obtained by reading @file{/proc/PID/smaps} on Linux. See `procs(5)' for details." (define mapping-line-rx + ;; As of Linux 2.6.32.28, an `smaps' line looks like this: + ;; "00400000-00401000 r-xp 00000000 fe:00 108264 /home/ludo/soft/bin/guile" (make-regexp - "^([[:xdigit:]]+)-([[:xdigit:]]+) ([rwx-]{3}[ps]) ([[:xdigit:]]+) [0-9]{2}:[0-9]{2} [0-9]+[[:blank:]]+(.*)$")) + "^([[:xdigit:]]+)-([[:xdigit:]]+) ([rwx-]{3}[ps]) ([[:xdigit:]]+) [[:xdigit:]]{2}:[[:xdigit:]]{2} [0-9]+[[:blank:]]+(.*)$")) (define rss-line-rx (make-regexp @@ -83,7 +85,7 @@ memory mapping of process @var{pid}. This information is obtained by reading (loop (read-line) result)))))))) (define (total-heap-size pid) - "Return the total heap size of process @var{pid}." + "Return a pair representing the total and RSS heap size of PID." (define heap-or-anon-rx (make-regexp "\\[(heap|anon)\\]")) From 4c2e13e548ad251dc0431e745c94e25e7cc36aef Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 12:07:48 +0100 Subject: [PATCH 044/183] psyntax: fold chi-top-sequence into chi-top * module/ice-9/psyntax.scm (chi-top-sequence): Pull chi-top into the body of this toplevel begin expander. This will let us do r6rs toplevel expansion correctly. (chi-top): Remove. (macroexpand): Dispatch to chi-top-sequence directly. --- module/ice-9/psyntax.scm | 245 +++++++++++++++++++++------------------ 1 file changed, 132 insertions(+), 113 deletions(-) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index fa63fd657..2947eb758 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -521,7 +521,7 @@ ;; (define-syntax) define-syntax ;; (local-syntax . rec?) let-syntax/letrec-syntax ;; (eval-when) eval-when - ;; #'. ( . ) pattern variables + ;; (syntax . ( . )) pattern variables ;; (global) assumed global variable ;; (lexical . ) lexical variables ;; (displaced-lexical) displaced lexicals @@ -899,14 +899,136 @@ (define chi-top-sequence (lambda (body r w s m esew mod) - (build-sequence s - (let dobody ((body body) (r r) (w w) (m m) (esew esew) - (mod mod) (out '())) - (if (null? body) - (reverse out) - (dobody (cdr body) r w m esew mod - (cons (chi-top (car body) r w m esew mod) out))))))) + (define (scan body r w s m esew mod exps) + (define-syntax eval-if-c&e + (syntax-rules () + ((_ m e mod) + (let ((x e)) + (if (eq? m 'c&e) (top-level-eval-hook x mod)) + x)))) + (cond + ((null? body) + ;; in reversed order + exps) + (else + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((e (car body))) + (syntax-type e r w (or (source-annotation e) s) #f mod #f))) + (lambda (type value e w s mod) + (case type + ((begin-form) + (syntax-case e () + ((_) exps) + ((_ e1 e2 ...) + (scan #'(e1 e2 ...) r w s m esew mod exps)))) + ((local-syntax-form) + (chi-local-syntax value e r w s mod + (lambda (body r w s mod) + (scan body r w s m esew mod exps)))) + ((eval-when-form) + (syntax-case e () + ((_ (x ...) e1 e2 ...) + (let ((when-list (chi-when-list e #'(x ...) w)) + (body #'(e1 e2 ...))) + (cond + ((eq? m 'e) + (if (memq 'eval when-list) + (scan body r w s + (if (memq 'expand when-list) 'c&e 'e) + '(eval) + mod exps) + (begin + (if (memq 'expand when-list) + (top-level-eval-hook + (chi-top-sequence body r w s 'e '(eval) mod) + mod)) + (values exps)))) + ((memq 'load when-list) + (if (or (memq 'compile when-list) + (memq 'expand when-list) + (and (eq? m 'c&e) (memq 'eval when-list))) + (scan body r w s 'c&e '(compile load) mod exps) + (if (memq m '(c c&e)) + (scan body r w s 'c '(load) mod exps) + (values exps)))) + ((or (memq 'compile when-list) + (memq 'expand when-list) + (and (eq? m 'c&e) (memq 'eval when-list))) + (top-level-eval-hook + (chi-top-sequence body r w s 'e '(eval) mod) + mod) + (values exps)) + (else + (values exps))))))) + ((define-syntax-form) + (let ((n (id-var-name value w)) (r (macros-only-env r))) + (case m + ((c) + (if (memq 'compile esew) + (let ((e (chi-install-global n (chi e r w mod)))) + (top-level-eval-hook e mod) + (if (memq 'load esew) + (values (cons e exps)) + (values exps))) + (if (memq 'load esew) + (values (cons (chi-install-global n (chi e r w mod)) + exps)) + (values exps)))) + ((c&e) + (let ((e (chi-install-global n (chi e r w mod)))) + (top-level-eval-hook e mod) + (values (cons e exps)))) + (else + (if (memq 'eval esew) + (top-level-eval-hook + (chi-install-global n (chi e r w mod)) + mod)) + (values exps))))) + ((define-form) + (let* ((n (id-var-name value w)) + ;; Lookup the name in the module of the define form. + (type (binding-type (lookup n r mod)))) + (case type + ((global core macro module-ref) + ;; affect compile-time environment (once we have booted) + (if (and (memq m '(c c&e)) + (not (module-local-variable (current-module) n)) + (current-module)) + (let ((old (module-variable (current-module) n))) + ;; use value of the same-named imported variable, if + ;; any + (if (and (variable? old) (variable-bound? old)) + (module-define! (current-module) n (variable-ref old)) + (module-add! (current-module) n (make-undefined-variable))))) + (values + (cons + (eval-if-c&e m + (build-global-definition s n (chi e r w mod)) + mod) + exps))) + ((displaced-lexical) + (syntax-violation #f "identifier out of context" + e (wrap value w mod))) + (else + (syntax-violation #f "cannot define keyword at top level" + e (wrap value w mod)))))) + (else + (values (cons + (eval-if-c&e m (chi-expr type value e r w s mod) mod) + exps))))))) + (lambda (exps) + (scan (cdr body) r w s m esew mod exps)))))) + (call-with-values (lambda () + (scan body r w s m esew mod '())) + (lambda (exps) + (if (null? exps) + (build-void s) + (build-sequence s (reverse exps))))))) + (define chi-install-global (lambda (name e) (build-global-definition @@ -1054,109 +1176,6 @@ ((self-evaluating? e) (values 'constant #f e w s mod)) (else (values 'other #f e w s mod))))) - (define chi-top - (lambda (e r w m esew mod) - (define-syntax eval-if-c&e - (syntax-rules () - ((_ m e mod) - (let ((x e)) - (if (eq? m 'c&e) (top-level-eval-hook x mod)) - x)))) - (call-with-values - (lambda () (syntax-type e r w (source-annotation e) #f mod #f)) - (lambda (type value e w s mod) - (case type - ((begin-form) - (syntax-case e () - ((_) (chi-void)) - ((_ e1 e2 ...) - (chi-top-sequence #'(e1 e2 ...) r w s m esew mod)))) - ((local-syntax-form) - (chi-local-syntax value e r w s mod - (lambda (body r w s mod) - (chi-top-sequence body r w s m esew mod)))) - ((eval-when-form) - (syntax-case e () - ((_ (x ...) e1 e2 ...) - (let ((when-list (chi-when-list e #'(x ...) w)) - (body #'(e1 e2 ...))) - (cond - ((eq? m 'e) - (if (memq 'eval when-list) - (chi-top-sequence body r w s - (if (memq 'expand when-list) 'c&e 'e) - '(eval) - mod) - (begin - (if (memq 'expand when-list) - (top-level-eval-hook - (chi-top-sequence body r w s 'e '(eval) mod) - mod)) - (chi-void)))) - ((memq 'load when-list) - (if (or (memq 'compile when-list) - (memq 'expand when-list) - (and (eq? m 'c&e) (memq 'eval when-list))) - (chi-top-sequence body r w s 'c&e '(compile load) mod) - (if (memq m '(c c&e)) - (chi-top-sequence body r w s 'c '(load) mod) - (chi-void)))) - ((or (memq 'compile when-list) - (memq 'expand when-list) - (and (eq? m 'c&e) (memq 'eval when-list))) - (top-level-eval-hook - (chi-top-sequence body r w s 'e '(eval) mod) - mod) - (chi-void)) - (else (chi-void))))))) - ((define-syntax-form) - (let ((n (id-var-name value w)) (r (macros-only-env r))) - (case m - ((c) - (if (memq 'compile esew) - (let ((e (chi-install-global n (chi e r w mod)))) - (top-level-eval-hook e mod) - (if (memq 'load esew) e (chi-void))) - (if (memq 'load esew) - (chi-install-global n (chi e r w mod)) - (chi-void)))) - ((c&e) - (let ((e (chi-install-global n (chi e r w mod)))) - (top-level-eval-hook e mod) - e)) - (else - (if (memq 'eval esew) - (top-level-eval-hook - (chi-install-global n (chi e r w mod)) - mod)) - (chi-void))))) - ((define-form) - (let* ((n (id-var-name value w)) - ;; Lookup the name in the module of the define form. - (type (binding-type (lookup n r mod)))) - (case type - ((global core macro module-ref) - ;; affect compile-time environment (once we have booted) - (if (and (memq m '(c c&e)) - (not (module-local-variable (current-module) n)) - (current-module)) - (let ((old (module-variable (current-module) n))) - ;; use value of the same-named imported variable, if - ;; any - (if (and (variable? old) (variable-bound? old)) - (module-define! (current-module) n (variable-ref old)) - (module-add! (current-module) n (make-undefined-variable))))) - (eval-if-c&e m - (build-global-definition s n (chi e r w mod)) - mod)) - ((displaced-lexical) - (syntax-violation #f "identifier out of context" - e (wrap value w mod))) - (else - (syntax-violation #f "cannot define keyword at top level" - e (wrap value w mod)))))) - (else (eval-if-c&e m (chi-expr type value e r w s mod) mod))))))) - (define chi (lambda (e r w mod) (call-with-values @@ -2375,8 +2394,8 @@ ;; the object file if we are compiling a file. (set! macroexpand (lambda* (x #:optional (m 'e) (esew '(eval))) - (chi-top x null-env top-wrap m esew - (cons 'hygiene (module-name (current-module)))))) + (chi-top-sequence (list x) null-env top-wrap #f m esew + (cons 'hygiene (module-name (current-module)))))) (set! identifier? (lambda (x) From 4da326f25dec2a2799c7be90cd026955be46525e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 12:48:23 +0100 Subject: [PATCH 045/183] chi-top-sequence defines macros before expanding other exps * module/ice-9/psyntax.scm (chi-top-sequence): Manually inline eval-if-c&e into its two call sites; I found it hard to understand otherwise. If the mode is just 'e, defer expansion of definitions and expressions until the end, so that they can be expanded in a context of all syntax expanders defined in the sequence. --- module/ice-9/psyntax.scm | 44 ++++++++++++++++++++++++++++++---------- 1 file changed, 33 insertions(+), 11 deletions(-) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 2947eb758..f5a7305b6 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -897,15 +897,23 @@ (let ((first (chi (car body) r w mod))) (cons first (dobody (cdr body) r w mod)))))))) + ;; At top-level, we allow mixed definitions and expressions. Like + ;; chi-body we expand in two passes. + ;; + ;; First, from left to right, we expand just enough to know what + ;; expressions are definitions, syntax definitions, and splicing + ;; statements (`begin'). If we anything needs evaluating at + ;; expansion-time, it is expanded directly. + ;; + ;; Otherwise we collect expressions to expand, in thunks, and then + ;; expand them all at the end. This allows all syntax expanders + ;; visible in a toplevel sequence to be visible during the + ;; expansions of all normal definitions and expressions in the + ;; sequence. + ;; (define chi-top-sequence (lambda (body r w s m esew mod) (define (scan body r w s m esew mod exps) - (define-syntax eval-if-c&e - (syntax-rules () - ((_ m e mod) - (let ((x e)) - (if (eq? m 'c&e) (top-level-eval-hook x mod)) - x)))) (cond ((null? body) ;; in reversed order @@ -1005,9 +1013,12 @@ (module-add! (current-module) n (make-undefined-variable))))) (values (cons - (eval-if-c&e m - (build-global-definition s n (chi e r w mod)) - mod) + (if (eq? m 'c&e) + (let ((x (build-global-definition s n (chi e r w mod)))) + (top-level-eval-hook x mod) + x) + (lambda () + (build-global-definition s n (chi e r w mod)))) exps))) ((displaced-lexical) (syntax-violation #f "identifier out of context" @@ -1017,7 +1028,12 @@ e (wrap value w mod)))))) (else (values (cons - (eval-if-c&e m (chi-expr type value e r w s mod) mod) + (if (eq? m 'c&e) + (let ((x (chi-expr type value e r w s mod))) + (top-level-eval-hook x mod) + x) + (lambda () + (chi-expr type value e r w s mod))) exps))))))) (lambda (exps) (scan (cdr body) r w s m esew mod exps)))))) @@ -1027,7 +1043,13 @@ (lambda (exps) (if (null? exps) (build-void s) - (build-sequence s (reverse exps))))))) + (build-sequence + s + (let lp ((in exps) (out '())) + (if (null? in) out + (let ((e (car in))) + (lp (cdr in) + (cons (if (procedure? e) (e) e) out))))))))))) (define chi-install-global (lambda (name e) From fa3df855e831d6782af68f6e2219fcde07cfb8ca Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 12:58:54 +0100 Subject: [PATCH 046/183] add syncase test * test-suite/tests/syncase.test ("top-level expansions"): New test. --- test-suite/tests/syncase.test | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test index 5f4856791..84f1cfc8b 100644 --- a/test-suite/tests/syncase.test +++ b/test-suite/tests/syncase.test @@ -1,6 +1,6 @@ ;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*- ;;;; -;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -220,3 +220,15 @@ (set! baz 50) (equal? (+ baz qux) 100))))) + +(with-test-prefix "top-level expansions" + (pass-if "syntax definitions expanded before other expressions" + (eval '(begin + (define even? + (lambda (x) + (or (= x 0) (odd? (- x 1))))) + (define-syntax odd? + (syntax-rules () + ((odd? x) (not (even? x))))) + (even? 10)) + (current-module)))) From 4335366389364885239dd5189ca747ed1d59e569 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 12:59:44 +0100 Subject: [PATCH 047/183] regenerate psyntax-pp * module/ice-9/psyntax-pp.scm: Regenerate. --- module/ice-9/psyntax-pp.scm | 17610 +++++++++++++++++----------------- 1 file changed, 8812 insertions(+), 8798 deletions(-) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 207e72c2f..fb862d019 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -2,1203 +2,1617 @@ (if #f #f) (letrec* - ((#{and-map*\ 37}# - (lambda (#{f\ 201}# #{first\ 202}# . #{rest\ 203}#) + ((#{and-map*\ 38}# + (lambda (#{f\ 202}# #{first\ 203}# . #{rest\ 204}#) (begin - (let ((#{t\ 209}# (null? #{first\ 202}#))) - (if #{t\ 209}# - #{t\ 209}# - (if (null? #{rest\ 203}#) + (let ((#{t\ 210}# (null? #{first\ 203}#))) + (if #{t\ 210}# + #{t\ 210}# + (if (null? #{rest\ 204}#) (letrec* - ((#{andmap\ 213}# - (lambda (#{first\ 214}#) + ((#{andmap\ 214}# + (lambda (#{first\ 215}#) (begin - (let ((#{x\ 217}# (car #{first\ 214}#)) - (#{first\ 218}# (cdr #{first\ 214}#))) - (if (null? #{first\ 218}#) - (#{f\ 201}# #{x\ 217}#) - (if (#{f\ 201}# #{x\ 217}#) - (#{andmap\ 213}# #{first\ 218}#) + (let ((#{x\ 218}# (car #{first\ 215}#)) + (#{first\ 219}# (cdr #{first\ 215}#))) + (if (null? #{first\ 219}#) + (#{f\ 202}# #{x\ 218}#) + (if (#{f\ 202}# #{x\ 218}#) + (#{andmap\ 214}# #{first\ 219}#) #f))))))) - (begin (#{andmap\ 213}# #{first\ 202}#))) + (begin (#{andmap\ 214}# #{first\ 203}#))) (letrec* - ((#{andmap\ 224}# - (lambda (#{first\ 225}# #{rest\ 226}#) + ((#{andmap\ 225}# + (lambda (#{first\ 226}# #{rest\ 227}#) (begin - (let ((#{x\ 231}# (car #{first\ 225}#)) - (#{xr\ 232}# (map car #{rest\ 226}#)) - (#{first\ 233}# (cdr #{first\ 225}#)) - (#{rest\ 234}# (map cdr #{rest\ 226}#))) - (if (null? #{first\ 233}#) - (@apply #{f\ 201}# #{x\ 231}# #{xr\ 232}#) - (if (@apply #{f\ 201}# #{x\ 231}# #{xr\ 232}#) - (#{andmap\ 224}# #{first\ 233}# #{rest\ 234}#) + (let ((#{x\ 232}# (car #{first\ 226}#)) + (#{xr\ 233}# (map car #{rest\ 227}#)) + (#{first\ 234}# (cdr #{first\ 226}#)) + (#{rest\ 235}# (map cdr #{rest\ 227}#))) + (if (null? #{first\ 234}#) + (@apply #{f\ 202}# #{x\ 232}# #{xr\ 233}#) + (if (@apply #{f\ 202}# #{x\ 232}# #{xr\ 233}#) + (#{andmap\ 225}# #{first\ 234}# #{rest\ 235}#) #f))))))) (begin - (#{andmap\ 224}# #{first\ 202}# #{rest\ 203}#)))))))))) + (#{andmap\ 225}# #{first\ 203}# #{rest\ 204}#)))))))))) (begin - (let ((#{make-primitive-ref\ 243}# (if #f #f)) - (#{fx+\ 282}# (if #f #f)) - (#{fx-\ 284}# (if #f #f)) - (#{fx=\ 286}# (if #f #f)) - (#{fx<\ 288}# (if #f #f)) - (#{set-syntax-object-expression!\ 353}# + (let ((#{make-primitive-ref\ 244}# (if #f #f)) + (#{fx+\ 283}# (if #f #f)) + (#{fx-\ 285}# (if #f #f)) + (#{fx=\ 287}# (if #f #f)) + (#{fx<\ 289}# (if #f #f)) + (#{set-syntax-object-expression!\ 354}# (if #f #f)) - (#{set-syntax-object-wrap!\ 355}# (if #f #f)) - (#{set-syntax-object-module!\ 357}# (if #f #f)) - (#{ribcage?\ 399}# (if #f #f))) + (#{set-syntax-object-wrap!\ 356}# (if #f #f)) + (#{set-syntax-object-module!\ 358}# (if #f #f)) + (#{ribcage?\ 400}# (if #f #f))) (letrec* - ((#{make-void\ 239}# - (lambda (#{src\ 751}#) + ((#{make-void\ 240}# + (lambda (#{src\ 750}#) (make-struct/no-tail (vector-ref %expanded-vtables 0) - #{src\ 751}#))) - (#{make-const\ 241}# - (lambda (#{src\ 753}# #{exp\ 754}#) + #{src\ 750}#))) + (#{make-const\ 242}# + (lambda (#{src\ 752}# #{exp\ 753}#) (make-struct/no-tail (vector-ref %expanded-vtables 1) - #{src\ 753}# - #{exp\ 754}#))) - (#{make-lexical-ref\ 245}# - (lambda (#{src\ 761}# #{name\ 762}# #{gensym\ 763}#) + #{src\ 752}# + #{exp\ 753}#))) + (#{make-lexical-ref\ 246}# + (lambda (#{src\ 760}# #{name\ 761}# #{gensym\ 762}#) (make-struct/no-tail (vector-ref %expanded-vtables 3) - #{src\ 761}# - #{name\ 762}# - #{gensym\ 763}#))) - (#{make-lexical-set\ 247}# - (lambda (#{src\ 767}# - #{name\ 768}# - #{gensym\ 769}# - #{exp\ 770}#) + #{src\ 760}# + #{name\ 761}# + #{gensym\ 762}#))) + (#{make-lexical-set\ 248}# + (lambda (#{src\ 766}# + #{name\ 767}# + #{gensym\ 768}# + #{exp\ 769}#) (make-struct/no-tail (vector-ref %expanded-vtables 4) - #{src\ 767}# - #{name\ 768}# - #{gensym\ 769}# - #{exp\ 770}#))) - (#{make-module-ref\ 249}# - (lambda (#{src\ 775}# - #{mod\ 776}# - #{name\ 777}# - #{public?\ 778}#) + #{src\ 766}# + #{name\ 767}# + #{gensym\ 768}# + #{exp\ 769}#))) + (#{make-module-ref\ 250}# + (lambda (#{src\ 774}# + #{mod\ 775}# + #{name\ 776}# + #{public?\ 777}#) (make-struct/no-tail (vector-ref %expanded-vtables 5) - #{src\ 775}# - #{mod\ 776}# - #{name\ 777}# - #{public?\ 778}#))) - (#{make-module-set\ 251}# - (lambda (#{src\ 783}# - #{mod\ 784}# - #{name\ 785}# - #{public?\ 786}# - #{exp\ 787}#) + #{src\ 774}# + #{mod\ 775}# + #{name\ 776}# + #{public?\ 777}#))) + (#{make-module-set\ 252}# + (lambda (#{src\ 782}# + #{mod\ 783}# + #{name\ 784}# + #{public?\ 785}# + #{exp\ 786}#) (make-struct/no-tail (vector-ref %expanded-vtables 6) - #{src\ 783}# - #{mod\ 784}# - #{name\ 785}# - #{public?\ 786}# - #{exp\ 787}#))) - (#{make-toplevel-ref\ 253}# - (lambda (#{src\ 793}# #{name\ 794}#) + #{src\ 782}# + #{mod\ 783}# + #{name\ 784}# + #{public?\ 785}# + #{exp\ 786}#))) + (#{make-toplevel-ref\ 254}# + (lambda (#{src\ 792}# #{name\ 793}#) (make-struct/no-tail (vector-ref %expanded-vtables 7) - #{src\ 793}# - #{name\ 794}#))) - (#{make-toplevel-set\ 255}# - (lambda (#{src\ 797}# #{name\ 798}# #{exp\ 799}#) + #{src\ 792}# + #{name\ 793}#))) + (#{make-toplevel-set\ 256}# + (lambda (#{src\ 796}# #{name\ 797}# #{exp\ 798}#) (make-struct/no-tail (vector-ref %expanded-vtables 8) - #{src\ 797}# - #{name\ 798}# - #{exp\ 799}#))) - (#{make-toplevel-define\ 257}# - (lambda (#{src\ 803}# #{name\ 804}# #{exp\ 805}#) + #{src\ 796}# + #{name\ 797}# + #{exp\ 798}#))) + (#{make-toplevel-define\ 258}# + (lambda (#{src\ 802}# #{name\ 803}# #{exp\ 804}#) (make-struct/no-tail (vector-ref %expanded-vtables 9) - #{src\ 803}# - #{name\ 804}# - #{exp\ 805}#))) - (#{make-conditional\ 259}# - (lambda (#{src\ 809}# - #{test\ 810}# - #{consequent\ 811}# - #{alternate\ 812}#) + #{src\ 802}# + #{name\ 803}# + #{exp\ 804}#))) + (#{make-conditional\ 260}# + (lambda (#{src\ 808}# + #{test\ 809}# + #{consequent\ 810}# + #{alternate\ 811}#) (make-struct/no-tail (vector-ref %expanded-vtables 10) - #{src\ 809}# - #{test\ 810}# - #{consequent\ 811}# - #{alternate\ 812}#))) - (#{make-application\ 261}# - (lambda (#{src\ 817}# #{proc\ 818}# #{args\ 819}#) + #{src\ 808}# + #{test\ 809}# + #{consequent\ 810}# + #{alternate\ 811}#))) + (#{make-application\ 262}# + (lambda (#{src\ 816}# #{proc\ 817}# #{args\ 818}#) (make-struct/no-tail (vector-ref %expanded-vtables 11) - #{src\ 817}# - #{proc\ 818}# - #{args\ 819}#))) - (#{make-sequence\ 263}# - (lambda (#{src\ 823}# #{exps\ 824}#) + #{src\ 816}# + #{proc\ 817}# + #{args\ 818}#))) + (#{make-sequence\ 264}# + (lambda (#{src\ 822}# #{exps\ 823}#) (make-struct/no-tail (vector-ref %expanded-vtables 12) - #{src\ 823}# - #{exps\ 824}#))) - (#{make-lambda\ 265}# - (lambda (#{src\ 827}# #{meta\ 828}# #{body\ 829}#) + #{src\ 822}# + #{exps\ 823}#))) + (#{make-lambda\ 266}# + (lambda (#{src\ 826}# #{meta\ 827}# #{body\ 828}#) (make-struct/no-tail (vector-ref %expanded-vtables 13) - #{src\ 827}# - #{meta\ 828}# - #{body\ 829}#))) - (#{make-lambda-case\ 267}# - (lambda (#{src\ 833}# - #{req\ 834}# - #{opt\ 835}# - #{rest\ 836}# - #{kw\ 837}# - #{inits\ 838}# - #{gensyms\ 839}# - #{body\ 840}# - #{alternate\ 841}#) + #{src\ 826}# + #{meta\ 827}# + #{body\ 828}#))) + (#{make-lambda-case\ 268}# + (lambda (#{src\ 832}# + #{req\ 833}# + #{opt\ 834}# + #{rest\ 835}# + #{kw\ 836}# + #{inits\ 837}# + #{gensyms\ 838}# + #{body\ 839}# + #{alternate\ 840}#) (make-struct/no-tail (vector-ref %expanded-vtables 14) - #{src\ 833}# - #{req\ 834}# - #{opt\ 835}# - #{rest\ 836}# - #{kw\ 837}# - #{inits\ 838}# - #{gensyms\ 839}# - #{body\ 840}# - #{alternate\ 841}#))) - (#{make-let\ 269}# - (lambda (#{src\ 851}# - #{names\ 852}# - #{gensyms\ 853}# - #{vals\ 854}# - #{body\ 855}#) + #{src\ 832}# + #{req\ 833}# + #{opt\ 834}# + #{rest\ 835}# + #{kw\ 836}# + #{inits\ 837}# + #{gensyms\ 838}# + #{body\ 839}# + #{alternate\ 840}#))) + (#{make-let\ 270}# + (lambda (#{src\ 850}# + #{names\ 851}# + #{gensyms\ 852}# + #{vals\ 853}# + #{body\ 854}#) (make-struct/no-tail (vector-ref %expanded-vtables 15) - #{src\ 851}# - #{names\ 852}# - #{gensyms\ 853}# - #{vals\ 854}# - #{body\ 855}#))) - (#{make-letrec\ 271}# - (lambda (#{src\ 861}# - #{in-order?\ 862}# - #{names\ 863}# - #{gensyms\ 864}# - #{vals\ 865}# - #{body\ 866}#) + #{src\ 850}# + #{names\ 851}# + #{gensyms\ 852}# + #{vals\ 853}# + #{body\ 854}#))) + (#{make-letrec\ 272}# + (lambda (#{src\ 860}# + #{in-order?\ 861}# + #{names\ 862}# + #{gensyms\ 863}# + #{vals\ 864}# + #{body\ 865}#) (make-struct/no-tail (vector-ref %expanded-vtables 16) - #{src\ 861}# - #{in-order?\ 862}# - #{names\ 863}# - #{gensyms\ 864}# - #{vals\ 865}# - #{body\ 866}#))) - (#{make-dynlet\ 273}# - (lambda (#{src\ 873}# - #{fluids\ 874}# - #{vals\ 875}# - #{body\ 876}#) + #{src\ 860}# + #{in-order?\ 861}# + #{names\ 862}# + #{gensyms\ 863}# + #{vals\ 864}# + #{body\ 865}#))) + (#{make-dynlet\ 274}# + (lambda (#{src\ 872}# + #{fluids\ 873}# + #{vals\ 874}# + #{body\ 875}#) (make-struct/no-tail (vector-ref %expanded-vtables 17) - #{src\ 873}# - #{fluids\ 874}# - #{vals\ 875}# - #{body\ 876}#))) - (#{lambda?\ 276}# - (lambda (#{x\ 881}#) - (if (struct? #{x\ 881}#) - (eq? (struct-vtable #{x\ 881}#) + #{src\ 872}# + #{fluids\ 873}# + #{vals\ 874}# + #{body\ 875}#))) + (#{lambda?\ 277}# + (lambda (#{x\ 880}#) + (if (struct? #{x\ 880}#) + (eq? (struct-vtable #{x\ 880}#) (vector-ref %expanded-vtables 13)) #f))) - (#{lambda-meta\ 278}# - (lambda (#{x\ 885}#) (struct-ref #{x\ 885}# 1))) - (#{set-lambda-meta!\ 280}# - (lambda (#{x\ 887}# #{v\ 888}#) - (struct-set! #{x\ 887}# 1 #{v\ 888}#))) - (#{top-level-eval-hook\ 290}# - (lambda (#{x\ 891}# #{mod\ 892}#) - (primitive-eval #{x\ 891}#))) - (#{local-eval-hook\ 292}# - (lambda (#{x\ 895}# #{mod\ 896}#) - (primitive-eval #{x\ 895}#))) - (#{put-global-definition-hook\ 295}# - (lambda (#{symbol\ 899}# #{type\ 900}# #{val\ 901}#) + (#{lambda-meta\ 279}# + (lambda (#{x\ 884}#) (struct-ref #{x\ 884}# 1))) + (#{set-lambda-meta!\ 281}# + (lambda (#{x\ 886}# #{v\ 887}#) + (struct-set! #{x\ 886}# 1 #{v\ 887}#))) + (#{top-level-eval-hook\ 291}# + (lambda (#{x\ 890}# #{mod\ 891}#) + (primitive-eval #{x\ 890}#))) + (#{local-eval-hook\ 293}# + (lambda (#{x\ 894}# #{mod\ 895}#) + (primitive-eval #{x\ 894}#))) + (#{put-global-definition-hook\ 296}# + (lambda (#{symbol\ 898}# #{type\ 899}# #{val\ 900}#) (module-define! (current-module) - #{symbol\ 899}# + #{symbol\ 898}# (make-syntax-transformer - #{symbol\ 899}# - #{type\ 900}# - #{val\ 901}#)))) - (#{get-global-definition-hook\ 297}# - (lambda (#{symbol\ 905}# #{module\ 906}#) + #{symbol\ 898}# + #{type\ 899}# + #{val\ 900}#)))) + (#{get-global-definition-hook\ 298}# + (lambda (#{symbol\ 904}# #{module\ 905}#) (begin - (if (if (not #{module\ 906}#) (current-module) #f) + (if (if (not #{module\ 905}#) (current-module) #f) (warn "module system is booted, we should have a module" - #{symbol\ 905}#)) + #{symbol\ 904}#)) (begin - (let ((#{v\ 912}# (module-variable - (if #{module\ 906}# - (resolve-module (cdr #{module\ 906}#)) + (let ((#{v\ 911}# (module-variable + (if #{module\ 905}# + (resolve-module (cdr #{module\ 905}#)) (current-module)) - #{symbol\ 905}#))) - (if #{v\ 912}# - (if (variable-bound? #{v\ 912}#) + #{symbol\ 904}#))) + (if #{v\ 911}# + (if (variable-bound? #{v\ 911}#) (begin - (let ((#{val\ 917}# (variable-ref #{v\ 912}#))) - (if (macro? #{val\ 917}#) - (if (macro-type #{val\ 917}#) - (cons (macro-type #{val\ 917}#) - (macro-binding #{val\ 917}#)) + (let ((#{val\ 916}# (variable-ref #{v\ 911}#))) + (if (macro? #{val\ 916}#) + (if (macro-type #{val\ 916}#) + (cons (macro-type #{val\ 916}#) + (macro-binding #{val\ 916}#)) #f) #f))) #f) #f)))))) - (#{decorate-source\ 299}# - (lambda (#{e\ 921}# #{s\ 922}#) + (#{decorate-source\ 300}# + (lambda (#{e\ 920}# #{s\ 921}#) (begin - (if (if (pair? #{e\ 921}#) #{s\ 922}# #f) - (set-source-properties! #{e\ 921}# #{s\ 922}#)) - #{e\ 921}#))) - (#{maybe-name-value!\ 301}# - (lambda (#{name\ 927}# #{val\ 928}#) - (if (#{lambda?\ 276}# #{val\ 928}#) + (if (if (pair? #{e\ 920}#) #{s\ 921}# #f) + (set-source-properties! #{e\ 920}# #{s\ 921}#)) + #{e\ 920}#))) + (#{maybe-name-value!\ 302}# + (lambda (#{name\ 926}# #{val\ 927}#) + (if (#{lambda?\ 277}# #{val\ 927}#) (begin - (let ((#{meta\ 932}# - (#{lambda-meta\ 278}# #{val\ 928}#))) - (if (not (assq 'name #{meta\ 932}#)) - (#{set-lambda-meta!\ 280}# - #{val\ 928}# - (cons (cons 'name #{name\ 927}#) #{meta\ 932}#)))))))) - (#{build-void\ 303}# - (lambda (#{source\ 933}#) - (#{make-void\ 239}# #{source\ 933}#))) - (#{build-application\ 305}# - (lambda (#{source\ 935}# - #{fun-exp\ 936}# - #{arg-exps\ 937}#) - (#{make-application\ 261}# - #{source\ 935}# - #{fun-exp\ 936}# - #{arg-exps\ 937}#))) - (#{build-conditional\ 307}# - (lambda (#{source\ 941}# - #{test-exp\ 942}# - #{then-exp\ 943}# - #{else-exp\ 944}#) - (#{make-conditional\ 259}# - #{source\ 941}# - #{test-exp\ 942}# - #{then-exp\ 943}# - #{else-exp\ 944}#))) - (#{build-dynlet\ 309}# - (lambda (#{source\ 949}# - #{fluids\ 950}# - #{vals\ 951}# - #{body\ 952}#) - (#{make-dynlet\ 273}# - #{source\ 949}# - #{fluids\ 950}# - #{vals\ 951}# - #{body\ 952}#))) - (#{build-lexical-reference\ 311}# - (lambda (#{type\ 957}# - #{source\ 958}# - #{name\ 959}# - #{var\ 960}#) - (#{make-lexical-ref\ 245}# - #{source\ 958}# - #{name\ 959}# - #{var\ 960}#))) - (#{build-lexical-assignment\ 313}# - (lambda (#{source\ 965}# - #{name\ 966}# - #{var\ 967}# - #{exp\ 968}#) + (let ((#{meta\ 931}# + (#{lambda-meta\ 279}# #{val\ 927}#))) + (if (not (assq 'name #{meta\ 931}#)) + (#{set-lambda-meta!\ 281}# + #{val\ 927}# + (cons (cons 'name #{name\ 926}#) #{meta\ 931}#)))))))) + (#{build-void\ 304}# + (lambda (#{source\ 932}#) + (#{make-void\ 240}# #{source\ 932}#))) + (#{build-application\ 306}# + (lambda (#{source\ 934}# + #{fun-exp\ 935}# + #{arg-exps\ 936}#) + (#{make-application\ 262}# + #{source\ 934}# + #{fun-exp\ 935}# + #{arg-exps\ 936}#))) + (#{build-conditional\ 308}# + (lambda (#{source\ 940}# + #{test-exp\ 941}# + #{then-exp\ 942}# + #{else-exp\ 943}#) + (#{make-conditional\ 260}# + #{source\ 940}# + #{test-exp\ 941}# + #{then-exp\ 942}# + #{else-exp\ 943}#))) + (#{build-dynlet\ 310}# + (lambda (#{source\ 948}# + #{fluids\ 949}# + #{vals\ 950}# + #{body\ 951}#) + (#{make-dynlet\ 274}# + #{source\ 948}# + #{fluids\ 949}# + #{vals\ 950}# + #{body\ 951}#))) + (#{build-lexical-reference\ 312}# + (lambda (#{type\ 956}# + #{source\ 957}# + #{name\ 958}# + #{var\ 959}#) + (#{make-lexical-ref\ 246}# + #{source\ 957}# + #{name\ 958}# + #{var\ 959}#))) + (#{build-lexical-assignment\ 314}# + (lambda (#{source\ 964}# + #{name\ 965}# + #{var\ 966}# + #{exp\ 967}#) (begin - (#{maybe-name-value!\ 301}# - #{name\ 966}# - #{exp\ 968}#) - (#{make-lexical-set\ 247}# - #{source\ 965}# - #{name\ 966}# - #{var\ 967}# - #{exp\ 968}#)))) - (#{analyze-variable\ 315}# - (lambda (#{mod\ 973}# - #{var\ 974}# - #{modref-cont\ 975}# - #{bare-cont\ 976}#) - (if (not #{mod\ 973}#) - (#{bare-cont\ 976}# #{var\ 974}#) + (#{maybe-name-value!\ 302}# + #{name\ 965}# + #{exp\ 967}#) + (#{make-lexical-set\ 248}# + #{source\ 964}# + #{name\ 965}# + #{var\ 966}# + #{exp\ 967}#)))) + (#{analyze-variable\ 316}# + (lambda (#{mod\ 972}# + #{var\ 973}# + #{modref-cont\ 974}# + #{bare-cont\ 975}#) + (if (not #{mod\ 972}#) + (#{bare-cont\ 975}# #{var\ 973}#) (begin - (let ((#{kind\ 983}# (car #{mod\ 973}#)) - (#{mod\ 984}# (cdr #{mod\ 973}#))) - (if (eqv? #{kind\ 983}# 'public) - (#{modref-cont\ 975}# - #{mod\ 984}# - #{var\ 974}# + (let ((#{kind\ 982}# (car #{mod\ 972}#)) + (#{mod\ 983}# (cdr #{mod\ 972}#))) + (if (eqv? #{kind\ 982}# 'public) + (#{modref-cont\ 974}# + #{mod\ 983}# + #{var\ 973}# #t) - (if (eqv? #{kind\ 983}# 'private) + (if (eqv? #{kind\ 982}# 'private) (if (not (equal? - #{mod\ 984}# + #{mod\ 983}# (module-name (current-module)))) - (#{modref-cont\ 975}# - #{mod\ 984}# - #{var\ 974}# + (#{modref-cont\ 974}# + #{mod\ 983}# + #{var\ 973}# #f) - (#{bare-cont\ 976}# #{var\ 974}#)) - (if (eqv? #{kind\ 983}# 'bare) - (#{bare-cont\ 976}# #{var\ 974}#) - (if (eqv? #{kind\ 983}# 'hygiene) + (#{bare-cont\ 975}# #{var\ 973}#)) + (if (eqv? #{kind\ 982}# 'bare) + (#{bare-cont\ 975}# #{var\ 973}#) + (if (eqv? #{kind\ 982}# 'hygiene) (if (if (not (equal? - #{mod\ 984}# + #{mod\ 983}# (module-name (current-module)))) (module-variable - (resolve-module #{mod\ 984}#) - #{var\ 974}#) + (resolve-module #{mod\ 983}#) + #{var\ 973}#) #f) - (#{modref-cont\ 975}# - #{mod\ 984}# - #{var\ 974}# + (#{modref-cont\ 974}# + #{mod\ 983}# + #{var\ 973}# #f) - (#{bare-cont\ 976}# #{var\ 974}#)) + (#{bare-cont\ 975}# #{var\ 973}#)) (syntax-violation #f "bad module kind" - #{var\ 974}# - #{mod\ 984}#)))))))))) - (#{build-global-reference\ 317}# - (lambda (#{source\ 992}# #{var\ 993}# #{mod\ 994}#) - (#{analyze-variable\ 315}# - #{mod\ 994}# - #{var\ 993}# - (lambda (#{mod\ 998}# #{var\ 999}# #{public?\ 1000}#) - (#{make-module-ref\ 249}# - #{source\ 992}# - #{mod\ 998}# - #{var\ 999}# - #{public?\ 1000}#)) - (lambda (#{var\ 1004}#) - (#{make-toplevel-ref\ 253}# - #{source\ 992}# - #{var\ 1004}#))))) - (#{build-global-assignment\ 319}# - (lambda (#{source\ 1006}# - #{var\ 1007}# - #{exp\ 1008}# - #{mod\ 1009}#) + #{var\ 973}# + #{mod\ 983}#)))))))))) + (#{build-global-reference\ 318}# + (lambda (#{source\ 991}# #{var\ 992}# #{mod\ 993}#) + (#{analyze-variable\ 316}# + #{mod\ 993}# + #{var\ 992}# + (lambda (#{mod\ 997}# #{var\ 998}# #{public?\ 999}#) + (#{make-module-ref\ 250}# + #{source\ 991}# + #{mod\ 997}# + #{var\ 998}# + #{public?\ 999}#)) + (lambda (#{var\ 1003}#) + (#{make-toplevel-ref\ 254}# + #{source\ 991}# + #{var\ 1003}#))))) + (#{build-global-assignment\ 320}# + (lambda (#{source\ 1005}# + #{var\ 1006}# + #{exp\ 1007}# + #{mod\ 1008}#) (begin - (#{maybe-name-value!\ 301}# - #{var\ 1007}# - #{exp\ 1008}#) - (#{analyze-variable\ 315}# - #{mod\ 1009}# - #{var\ 1007}# - (lambda (#{mod\ 1014}# #{var\ 1015}# #{public?\ 1016}#) - (#{make-module-set\ 251}# - #{source\ 1006}# - #{mod\ 1014}# - #{var\ 1015}# - #{public?\ 1016}# - #{exp\ 1008}#)) - (lambda (#{var\ 1020}#) - (#{make-toplevel-set\ 255}# - #{source\ 1006}# - #{var\ 1020}# - #{exp\ 1008}#)))))) - (#{build-global-definition\ 321}# - (lambda (#{source\ 1022}# #{var\ 1023}# #{exp\ 1024}#) + (#{maybe-name-value!\ 302}# + #{var\ 1006}# + #{exp\ 1007}#) + (#{analyze-variable\ 316}# + #{mod\ 1008}# + #{var\ 1006}# + (lambda (#{mod\ 1013}# #{var\ 1014}# #{public?\ 1015}#) + (#{make-module-set\ 252}# + #{source\ 1005}# + #{mod\ 1013}# + #{var\ 1014}# + #{public?\ 1015}# + #{exp\ 1007}#)) + (lambda (#{var\ 1019}#) + (#{make-toplevel-set\ 256}# + #{source\ 1005}# + #{var\ 1019}# + #{exp\ 1007}#)))))) + (#{build-global-definition\ 322}# + (lambda (#{source\ 1021}# #{var\ 1022}# #{exp\ 1023}#) (begin - (#{maybe-name-value!\ 301}# - #{var\ 1023}# - #{exp\ 1024}#) - (#{make-toplevel-define\ 257}# - #{source\ 1022}# - #{var\ 1023}# - #{exp\ 1024}#)))) - (#{build-simple-lambda\ 323}# - (lambda (#{src\ 1028}# - #{req\ 1029}# - #{rest\ 1030}# - #{vars\ 1031}# - #{meta\ 1032}# - #{exp\ 1033}#) - (#{make-lambda\ 265}# - #{src\ 1028}# - #{meta\ 1032}# - (#{make-lambda-case\ 267}# - #{src\ 1028}# - #{req\ 1029}# + (#{maybe-name-value!\ 302}# + #{var\ 1022}# + #{exp\ 1023}#) + (#{make-toplevel-define\ 258}# + #{source\ 1021}# + #{var\ 1022}# + #{exp\ 1023}#)))) + (#{build-simple-lambda\ 324}# + (lambda (#{src\ 1027}# + #{req\ 1028}# + #{rest\ 1029}# + #{vars\ 1030}# + #{meta\ 1031}# + #{exp\ 1032}#) + (#{make-lambda\ 266}# + #{src\ 1027}# + #{meta\ 1031}# + (#{make-lambda-case\ 268}# + #{src\ 1027}# + #{req\ 1028}# #f - #{rest\ 1030}# + #{rest\ 1029}# #f '() - #{vars\ 1031}# - #{exp\ 1033}# + #{vars\ 1030}# + #{exp\ 1032}# #f)))) - (#{build-case-lambda\ 325}# - (lambda (#{src\ 1040}# #{meta\ 1041}# #{body\ 1042}#) - (#{make-lambda\ 265}# - #{src\ 1040}# - #{meta\ 1041}# - #{body\ 1042}#))) - (#{build-lambda-case\ 327}# - (lambda (#{src\ 1046}# - #{req\ 1047}# - #{opt\ 1048}# - #{rest\ 1049}# - #{kw\ 1050}# - #{inits\ 1051}# - #{vars\ 1052}# - #{body\ 1053}# - #{else-case\ 1054}#) - (#{make-lambda-case\ 267}# - #{src\ 1046}# - #{req\ 1047}# - #{opt\ 1048}# - #{rest\ 1049}# - #{kw\ 1050}# - #{inits\ 1051}# - #{vars\ 1052}# - #{body\ 1053}# - #{else-case\ 1054}#))) - (#{build-primref\ 329}# - (lambda (#{src\ 1064}# #{name\ 1065}#) + (#{build-case-lambda\ 326}# + (lambda (#{src\ 1039}# #{meta\ 1040}# #{body\ 1041}#) + (#{make-lambda\ 266}# + #{src\ 1039}# + #{meta\ 1040}# + #{body\ 1041}#))) + (#{build-lambda-case\ 328}# + (lambda (#{src\ 1045}# + #{req\ 1046}# + #{opt\ 1047}# + #{rest\ 1048}# + #{kw\ 1049}# + #{inits\ 1050}# + #{vars\ 1051}# + #{body\ 1052}# + #{else-case\ 1053}#) + (#{make-lambda-case\ 268}# + #{src\ 1045}# + #{req\ 1046}# + #{opt\ 1047}# + #{rest\ 1048}# + #{kw\ 1049}# + #{inits\ 1050}# + #{vars\ 1051}# + #{body\ 1052}# + #{else-case\ 1053}#))) + (#{build-primref\ 330}# + (lambda (#{src\ 1063}# #{name\ 1064}#) (if (equal? (module-name (current-module)) '(guile)) - (#{make-toplevel-ref\ 253}# - #{src\ 1064}# - #{name\ 1065}#) - (#{make-module-ref\ 249}# - #{src\ 1064}# + (#{make-toplevel-ref\ 254}# + #{src\ 1063}# + #{name\ 1064}#) + (#{make-module-ref\ 250}# + #{src\ 1063}# '(guile) - #{name\ 1065}# + #{name\ 1064}# #f)))) - (#{build-data\ 331}# - (lambda (#{src\ 1068}# #{exp\ 1069}#) - (#{make-const\ 241}# #{src\ 1068}# #{exp\ 1069}#))) - (#{build-sequence\ 333}# - (lambda (#{src\ 1072}# #{exps\ 1073}#) - (if (null? (cdr #{exps\ 1073}#)) - (car #{exps\ 1073}#) - (#{make-sequence\ 263}# - #{src\ 1072}# - #{exps\ 1073}#)))) - (#{build-let\ 335}# - (lambda (#{src\ 1076}# - #{ids\ 1077}# - #{vars\ 1078}# - #{val-exps\ 1079}# - #{body-exp\ 1080}#) + (#{build-data\ 332}# + (lambda (#{src\ 1067}# #{exp\ 1068}#) + (#{make-const\ 242}# #{src\ 1067}# #{exp\ 1068}#))) + (#{build-sequence\ 334}# + (lambda (#{src\ 1071}# #{exps\ 1072}#) + (if (null? (cdr #{exps\ 1072}#)) + (car #{exps\ 1072}#) + (#{make-sequence\ 264}# + #{src\ 1071}# + #{exps\ 1072}#)))) + (#{build-let\ 336}# + (lambda (#{src\ 1075}# + #{ids\ 1076}# + #{vars\ 1077}# + #{val-exps\ 1078}# + #{body-exp\ 1079}#) (begin (for-each - #{maybe-name-value!\ 301}# - #{ids\ 1077}# - #{val-exps\ 1079}#) - (if (null? #{vars\ 1078}#) - #{body-exp\ 1080}# - (#{make-let\ 269}# - #{src\ 1076}# - #{ids\ 1077}# - #{vars\ 1078}# - #{val-exps\ 1079}# - #{body-exp\ 1080}#))))) - (#{build-named-let\ 337}# - (lambda (#{src\ 1086}# - #{ids\ 1087}# - #{vars\ 1088}# - #{val-exps\ 1089}# - #{body-exp\ 1090}#) + #{maybe-name-value!\ 302}# + #{ids\ 1076}# + #{val-exps\ 1078}#) + (if (null? #{vars\ 1077}#) + #{body-exp\ 1079}# + (#{make-let\ 270}# + #{src\ 1075}# + #{ids\ 1076}# + #{vars\ 1077}# + #{val-exps\ 1078}# + #{body-exp\ 1079}#))))) + (#{build-named-let\ 338}# + (lambda (#{src\ 1085}# + #{ids\ 1086}# + #{vars\ 1087}# + #{val-exps\ 1088}# + #{body-exp\ 1089}#) (begin - (let ((#{f\ 1100}# (car #{vars\ 1088}#)) - (#{f-name\ 1101}# (car #{ids\ 1087}#)) - (#{vars\ 1102}# (cdr #{vars\ 1088}#)) - (#{ids\ 1103}# (cdr #{ids\ 1087}#))) + (let ((#{f\ 1099}# (car #{vars\ 1087}#)) + (#{f-name\ 1100}# (car #{ids\ 1086}#)) + (#{vars\ 1101}# (cdr #{vars\ 1087}#)) + (#{ids\ 1102}# (cdr #{ids\ 1086}#))) (begin - (let ((#{proc\ 1105}# - (#{build-simple-lambda\ 323}# - #{src\ 1086}# - #{ids\ 1103}# + (let ((#{proc\ 1104}# + (#{build-simple-lambda\ 324}# + #{src\ 1085}# + #{ids\ 1102}# #f - #{vars\ 1102}# + #{vars\ 1101}# '() - #{body-exp\ 1090}#))) + #{body-exp\ 1089}#))) (begin - (#{maybe-name-value!\ 301}# - #{f-name\ 1101}# - #{proc\ 1105}#) + (#{maybe-name-value!\ 302}# + #{f-name\ 1100}# + #{proc\ 1104}#) (for-each - #{maybe-name-value!\ 301}# - #{ids\ 1103}# - #{val-exps\ 1089}#) - (#{make-letrec\ 271}# - #{src\ 1086}# + #{maybe-name-value!\ 302}# + #{ids\ 1102}# + #{val-exps\ 1088}#) + (#{make-letrec\ 272}# + #{src\ 1085}# #f - (list #{f-name\ 1101}#) - (list #{f\ 1100}#) - (list #{proc\ 1105}#) - (#{build-application\ 305}# - #{src\ 1086}# - (#{build-lexical-reference\ 311}# + (list #{f-name\ 1100}#) + (list #{f\ 1099}#) + (list #{proc\ 1104}#) + (#{build-application\ 306}# + #{src\ 1085}# + (#{build-lexical-reference\ 312}# 'fun - #{src\ 1086}# - #{f-name\ 1101}# - #{f\ 1100}#) - #{val-exps\ 1089}#))))))))) - (#{build-letrec\ 339}# - (lambda (#{src\ 1106}# - #{in-order?\ 1107}# - #{ids\ 1108}# - #{vars\ 1109}# - #{val-exps\ 1110}# - #{body-exp\ 1111}#) - (if (null? #{vars\ 1109}#) - #{body-exp\ 1111}# + #{src\ 1085}# + #{f-name\ 1100}# + #{f\ 1099}#) + #{val-exps\ 1088}#))))))))) + (#{build-letrec\ 340}# + (lambda (#{src\ 1105}# + #{in-order?\ 1106}# + #{ids\ 1107}# + #{vars\ 1108}# + #{val-exps\ 1109}# + #{body-exp\ 1110}#) + (if (null? #{vars\ 1108}#) + #{body-exp\ 1110}# (begin (for-each - #{maybe-name-value!\ 301}# - #{ids\ 1108}# - #{val-exps\ 1110}#) - (#{make-letrec\ 271}# - #{src\ 1106}# - #{in-order?\ 1107}# - #{ids\ 1108}# - #{vars\ 1109}# - #{val-exps\ 1110}# - #{body-exp\ 1111}#))))) - (#{make-syntax-object\ 343}# - (lambda (#{expression\ 1118}# - #{wrap\ 1119}# - #{module\ 1120}#) + #{maybe-name-value!\ 302}# + #{ids\ 1107}# + #{val-exps\ 1109}#) + (#{make-letrec\ 272}# + #{src\ 1105}# + #{in-order?\ 1106}# + #{ids\ 1107}# + #{vars\ 1108}# + #{val-exps\ 1109}# + #{body-exp\ 1110}#))))) + (#{make-syntax-object\ 344}# + (lambda (#{expression\ 1117}# + #{wrap\ 1118}# + #{module\ 1119}#) (vector 'syntax-object - #{expression\ 1118}# - #{wrap\ 1119}# - #{module\ 1120}#))) - (#{syntax-object?\ 345}# - (lambda (#{x\ 1124}#) - (if (vector? #{x\ 1124}#) - (if (= (vector-length #{x\ 1124}#) 4) - (eq? (vector-ref #{x\ 1124}# 0) 'syntax-object) + #{expression\ 1117}# + #{wrap\ 1118}# + #{module\ 1119}#))) + (#{syntax-object?\ 346}# + (lambda (#{x\ 1123}#) + (if (vector? #{x\ 1123}#) + (if (= (vector-length #{x\ 1123}#) 4) + (eq? (vector-ref #{x\ 1123}# 0) 'syntax-object) #f) #f))) - (#{syntax-object-expression\ 347}# - (lambda (#{x\ 1129}#) (vector-ref #{x\ 1129}# 1))) - (#{syntax-object-wrap\ 349}# - (lambda (#{x\ 1131}#) (vector-ref #{x\ 1131}# 2))) - (#{syntax-object-module\ 351}# - (lambda (#{x\ 1133}#) (vector-ref #{x\ 1133}# 3))) - (#{source-annotation\ 360}# - (lambda (#{x\ 1147}#) - (if (#{syntax-object?\ 345}# #{x\ 1147}#) - (#{source-annotation\ 360}# - (#{syntax-object-expression\ 347}# #{x\ 1147}#)) - (if (pair? #{x\ 1147}#) + (#{syntax-object-expression\ 348}# + (lambda (#{x\ 1128}#) (vector-ref #{x\ 1128}# 1))) + (#{syntax-object-wrap\ 350}# + (lambda (#{x\ 1130}#) (vector-ref #{x\ 1130}# 2))) + (#{syntax-object-module\ 352}# + (lambda (#{x\ 1132}#) (vector-ref #{x\ 1132}# 3))) + (#{source-annotation\ 361}# + (lambda (#{x\ 1146}#) + (if (#{syntax-object?\ 346}# #{x\ 1146}#) + (#{source-annotation\ 361}# + (#{syntax-object-expression\ 348}# #{x\ 1146}#)) + (if (pair? #{x\ 1146}#) (begin - (let ((#{props\ 1154}# (source-properties #{x\ 1147}#))) - (if (pair? #{props\ 1154}#) #{props\ 1154}# #f))) + (let ((#{props\ 1153}# (source-properties #{x\ 1146}#))) + (if (pair? #{props\ 1153}#) #{props\ 1153}# #f))) #f)))) - (#{extend-env\ 367}# - (lambda (#{labels\ 1156}# #{bindings\ 1157}# #{r\ 1158}#) - (if (null? #{labels\ 1156}#) - #{r\ 1158}# - (#{extend-env\ 367}# - (cdr #{labels\ 1156}#) - (cdr #{bindings\ 1157}#) - (cons (cons (car #{labels\ 1156}#) - (car #{bindings\ 1157}#)) - #{r\ 1158}#))))) - (#{extend-var-env\ 369}# - (lambda (#{labels\ 1162}# #{vars\ 1163}# #{r\ 1164}#) - (if (null? #{labels\ 1162}#) - #{r\ 1164}# - (#{extend-var-env\ 369}# - (cdr #{labels\ 1162}#) - (cdr #{vars\ 1163}#) - (cons (cons (car #{labels\ 1162}#) - (cons 'lexical (car #{vars\ 1163}#))) - #{r\ 1164}#))))) - (#{macros-only-env\ 371}# - (lambda (#{r\ 1169}#) - (if (null? #{r\ 1169}#) + (#{extend-env\ 368}# + (lambda (#{labels\ 1155}# #{bindings\ 1156}# #{r\ 1157}#) + (if (null? #{labels\ 1155}#) + #{r\ 1157}# + (#{extend-env\ 368}# + (cdr #{labels\ 1155}#) + (cdr #{bindings\ 1156}#) + (cons (cons (car #{labels\ 1155}#) + (car #{bindings\ 1156}#)) + #{r\ 1157}#))))) + (#{extend-var-env\ 370}# + (lambda (#{labels\ 1161}# #{vars\ 1162}# #{r\ 1163}#) + (if (null? #{labels\ 1161}#) + #{r\ 1163}# + (#{extend-var-env\ 370}# + (cdr #{labels\ 1161}#) + (cdr #{vars\ 1162}#) + (cons (cons (car #{labels\ 1161}#) + (cons 'lexical (car #{vars\ 1162}#))) + #{r\ 1163}#))))) + (#{macros-only-env\ 372}# + (lambda (#{r\ 1168}#) + (if (null? #{r\ 1168}#) '() (begin - (let ((#{a\ 1172}# (car #{r\ 1169}#))) - (if (eq? (car (cdr #{a\ 1172}#)) 'macro) - (cons #{a\ 1172}# - (#{macros-only-env\ 371}# (cdr #{r\ 1169}#))) - (#{macros-only-env\ 371}# (cdr #{r\ 1169}#)))))))) - (#{lookup\ 373}# - (lambda (#{x\ 1173}# #{r\ 1174}# #{mod\ 1175}#) + (let ((#{a\ 1171}# (car #{r\ 1168}#))) + (if (eq? (car (cdr #{a\ 1171}#)) 'macro) + (cons #{a\ 1171}# + (#{macros-only-env\ 372}# (cdr #{r\ 1168}#))) + (#{macros-only-env\ 372}# (cdr #{r\ 1168}#)))))))) + (#{lookup\ 374}# + (lambda (#{x\ 1172}# #{r\ 1173}# #{mod\ 1174}#) (begin - (let ((#{t\ 1181}# (assq #{x\ 1173}# #{r\ 1174}#))) - (if #{t\ 1181}# - (cdr #{t\ 1181}#) - (if (symbol? #{x\ 1173}#) + (let ((#{t\ 1180}# (assq #{x\ 1172}# #{r\ 1173}#))) + (if #{t\ 1180}# + (cdr #{t\ 1180}#) + (if (symbol? #{x\ 1172}#) (begin - (let ((#{t\ 1187}# - (#{get-global-definition-hook\ 297}# - #{x\ 1173}# - #{mod\ 1175}#))) - (if #{t\ 1187}# #{t\ 1187}# '(global)))) + (let ((#{t\ 1186}# + (#{get-global-definition-hook\ 298}# + #{x\ 1172}# + #{mod\ 1174}#))) + (if #{t\ 1186}# #{t\ 1186}# '(global)))) '(displaced-lexical))))))) - (#{global-extend\ 375}# - (lambda (#{type\ 1192}# #{sym\ 1193}# #{val\ 1194}#) - (#{put-global-definition-hook\ 295}# - #{sym\ 1193}# - #{type\ 1192}# - #{val\ 1194}#))) - (#{nonsymbol-id?\ 377}# - (lambda (#{x\ 1198}#) - (if (#{syntax-object?\ 345}# #{x\ 1198}#) + (#{global-extend\ 376}# + (lambda (#{type\ 1191}# #{sym\ 1192}# #{val\ 1193}#) + (#{put-global-definition-hook\ 296}# + #{sym\ 1192}# + #{type\ 1191}# + #{val\ 1193}#))) + (#{nonsymbol-id?\ 378}# + (lambda (#{x\ 1197}#) + (if (#{syntax-object?\ 346}# #{x\ 1197}#) (symbol? - (#{syntax-object-expression\ 347}# #{x\ 1198}#)) + (#{syntax-object-expression\ 348}# #{x\ 1197}#)) #f))) - (#{id?\ 379}# - (lambda (#{x\ 1202}#) - (if (symbol? #{x\ 1202}#) + (#{id?\ 380}# + (lambda (#{x\ 1201}#) + (if (symbol? #{x\ 1201}#) #t - (if (#{syntax-object?\ 345}# #{x\ 1202}#) + (if (#{syntax-object?\ 346}# #{x\ 1201}#) (symbol? - (#{syntax-object-expression\ 347}# #{x\ 1202}#)) + (#{syntax-object-expression\ 348}# #{x\ 1201}#)) #f)))) - (#{id-sym-name&marks\ 382}# - (lambda (#{x\ 1209}# #{w\ 1210}#) - (if (#{syntax-object?\ 345}# #{x\ 1209}#) + (#{id-sym-name&marks\ 383}# + (lambda (#{x\ 1208}# #{w\ 1209}#) + (if (#{syntax-object?\ 346}# #{x\ 1208}#) (values - (#{syntax-object-expression\ 347}# #{x\ 1209}#) - (#{join-marks\ 429}# - (car #{w\ 1210}#) - (car (#{syntax-object-wrap\ 349}# #{x\ 1209}#)))) - (values #{x\ 1209}# (car #{w\ 1210}#))))) - (#{gen-label\ 392}# + (#{syntax-object-expression\ 348}# #{x\ 1208}#) + (#{join-marks\ 430}# + (car #{w\ 1209}#) + (car (#{syntax-object-wrap\ 350}# #{x\ 1208}#)))) + (values #{x\ 1208}# (car #{w\ 1209}#))))) + (#{gen-label\ 393}# (lambda () (symbol->string (gensym "i")))) - (#{gen-labels\ 394}# - (lambda (#{ls\ 1216}#) - (if (null? #{ls\ 1216}#) + (#{gen-labels\ 395}# + (lambda (#{ls\ 1215}#) + (if (null? #{ls\ 1215}#) '() - (cons (#{gen-label\ 392}#) - (#{gen-labels\ 394}# (cdr #{ls\ 1216}#)))))) - (#{make-ribcage\ 397}# - (lambda (#{symnames\ 1218}# - #{marks\ 1219}# - #{labels\ 1220}#) + (cons (#{gen-label\ 393}#) + (#{gen-labels\ 395}# (cdr #{ls\ 1215}#)))))) + (#{make-ribcage\ 398}# + (lambda (#{symnames\ 1217}# + #{marks\ 1218}# + #{labels\ 1219}#) (vector 'ribcage - #{symnames\ 1218}# - #{marks\ 1219}# - #{labels\ 1220}#))) - (#{ribcage-symnames\ 401}# - (lambda (#{x\ 1229}#) (vector-ref #{x\ 1229}# 1))) - (#{ribcage-marks\ 403}# - (lambda (#{x\ 1231}#) (vector-ref #{x\ 1231}# 2))) - (#{ribcage-labels\ 405}# - (lambda (#{x\ 1233}#) (vector-ref #{x\ 1233}# 3))) - (#{set-ribcage-symnames!\ 407}# - (lambda (#{x\ 1235}# #{update\ 1236}#) - (vector-set! #{x\ 1235}# 1 #{update\ 1236}#))) - (#{set-ribcage-marks!\ 409}# - (lambda (#{x\ 1239}# #{update\ 1240}#) - (vector-set! #{x\ 1239}# 2 #{update\ 1240}#))) - (#{set-ribcage-labels!\ 411}# - (lambda (#{x\ 1243}# #{update\ 1244}#) - (vector-set! #{x\ 1243}# 3 #{update\ 1244}#))) - (#{anti-mark\ 417}# - (lambda (#{w\ 1247}#) - (cons (cons #f (car #{w\ 1247}#)) - (cons 'shift (cdr #{w\ 1247}#))))) - (#{extend-ribcage!\ 421}# - (lambda (#{ribcage\ 1253}# #{id\ 1254}# #{label\ 1255}#) + #{symnames\ 1217}# + #{marks\ 1218}# + #{labels\ 1219}#))) + (#{ribcage-symnames\ 402}# + (lambda (#{x\ 1228}#) (vector-ref #{x\ 1228}# 1))) + (#{ribcage-marks\ 404}# + (lambda (#{x\ 1230}#) (vector-ref #{x\ 1230}# 2))) + (#{ribcage-labels\ 406}# + (lambda (#{x\ 1232}#) (vector-ref #{x\ 1232}# 3))) + (#{set-ribcage-symnames!\ 408}# + (lambda (#{x\ 1234}# #{update\ 1235}#) + (vector-set! #{x\ 1234}# 1 #{update\ 1235}#))) + (#{set-ribcage-marks!\ 410}# + (lambda (#{x\ 1238}# #{update\ 1239}#) + (vector-set! #{x\ 1238}# 2 #{update\ 1239}#))) + (#{set-ribcage-labels!\ 412}# + (lambda (#{x\ 1242}# #{update\ 1243}#) + (vector-set! #{x\ 1242}# 3 #{update\ 1243}#))) + (#{anti-mark\ 418}# + (lambda (#{w\ 1246}#) + (cons (cons #f (car #{w\ 1246}#)) + (cons 'shift (cdr #{w\ 1246}#))))) + (#{extend-ribcage!\ 422}# + (lambda (#{ribcage\ 1252}# #{id\ 1253}# #{label\ 1254}#) (begin - (#{set-ribcage-symnames!\ 407}# - #{ribcage\ 1253}# - (cons (#{syntax-object-expression\ 347}# #{id\ 1254}#) - (#{ribcage-symnames\ 401}# #{ribcage\ 1253}#))) - (#{set-ribcage-marks!\ 409}# - #{ribcage\ 1253}# - (cons (car (#{syntax-object-wrap\ 349}# #{id\ 1254}#)) - (#{ribcage-marks\ 403}# #{ribcage\ 1253}#))) - (#{set-ribcage-labels!\ 411}# - #{ribcage\ 1253}# - (cons #{label\ 1255}# - (#{ribcage-labels\ 405}# #{ribcage\ 1253}#)))))) - (#{make-binding-wrap\ 423}# - (lambda (#{ids\ 1260}# #{labels\ 1261}# #{w\ 1262}#) - (if (null? #{ids\ 1260}#) - #{w\ 1262}# - (cons (car #{w\ 1262}#) + (#{set-ribcage-symnames!\ 408}# + #{ribcage\ 1252}# + (cons (#{syntax-object-expression\ 348}# #{id\ 1253}#) + (#{ribcage-symnames\ 402}# #{ribcage\ 1252}#))) + (#{set-ribcage-marks!\ 410}# + #{ribcage\ 1252}# + (cons (car (#{syntax-object-wrap\ 350}# #{id\ 1253}#)) + (#{ribcage-marks\ 404}# #{ribcage\ 1252}#))) + (#{set-ribcage-labels!\ 412}# + #{ribcage\ 1252}# + (cons #{label\ 1254}# + (#{ribcage-labels\ 406}# #{ribcage\ 1252}#)))))) + (#{make-binding-wrap\ 424}# + (lambda (#{ids\ 1259}# #{labels\ 1260}# #{w\ 1261}#) + (if (null? #{ids\ 1259}#) + #{w\ 1261}# + (cons (car #{w\ 1261}#) (cons (begin - (let ((#{labelvec\ 1269}# - (list->vector #{labels\ 1261}#))) + (let ((#{labelvec\ 1268}# + (list->vector #{labels\ 1260}#))) (begin - (let ((#{n\ 1271}# - (vector-length #{labelvec\ 1269}#))) + (let ((#{n\ 1270}# + (vector-length #{labelvec\ 1268}#))) (begin - (let ((#{symnamevec\ 1274}# - (make-vector #{n\ 1271}#)) - (#{marksvec\ 1275}# - (make-vector #{n\ 1271}#))) + (let ((#{symnamevec\ 1273}# + (make-vector #{n\ 1270}#)) + (#{marksvec\ 1274}# + (make-vector #{n\ 1270}#))) (begin (letrec* - ((#{f\ 1279}# - (lambda (#{ids\ 1280}# - #{i\ 1281}#) - (if (not (null? #{ids\ 1280}#)) + ((#{f\ 1278}# + (lambda (#{ids\ 1279}# + #{i\ 1280}#) + (if (not (null? #{ids\ 1279}#)) (call-with-values (lambda () - (#{id-sym-name&marks\ 382}# - (car #{ids\ 1280}#) - #{w\ 1262}#)) - (lambda (#{symname\ 1282}# - #{marks\ 1283}#) + (#{id-sym-name&marks\ 383}# + (car #{ids\ 1279}#) + #{w\ 1261}#)) + (lambda (#{symname\ 1281}# + #{marks\ 1282}#) (begin (vector-set! - #{symnamevec\ 1274}# - #{i\ 1281}# - #{symname\ 1282}#) + #{symnamevec\ 1273}# + #{i\ 1280}# + #{symname\ 1281}#) (vector-set! - #{marksvec\ 1275}# - #{i\ 1281}# - #{marks\ 1283}#) - (#{f\ 1279}# - (cdr #{ids\ 1280}#) - (#{fx+\ 282}# - #{i\ 1281}# + #{marksvec\ 1274}# + #{i\ 1280}# + #{marks\ 1282}#) + (#{f\ 1278}# + (cdr #{ids\ 1279}#) + (#{fx+\ 283}# + #{i\ 1280}# 1))))))))) (begin - (#{f\ 1279}# #{ids\ 1260}# 0))) - (#{make-ribcage\ 397}# - #{symnamevec\ 1274}# - #{marksvec\ 1275}# - #{labelvec\ 1269}#)))))))) - (cdr #{w\ 1262}#)))))) - (#{smart-append\ 425}# - (lambda (#{m1\ 1287}# #{m2\ 1288}#) - (if (null? #{m2\ 1288}#) - #{m1\ 1287}# - (append #{m1\ 1287}# #{m2\ 1288}#)))) - (#{join-wraps\ 427}# - (lambda (#{w1\ 1291}# #{w2\ 1292}#) + (#{f\ 1278}# #{ids\ 1259}# 0))) + (#{make-ribcage\ 398}# + #{symnamevec\ 1273}# + #{marksvec\ 1274}# + #{labelvec\ 1268}#)))))))) + (cdr #{w\ 1261}#)))))) + (#{smart-append\ 426}# + (lambda (#{m1\ 1286}# #{m2\ 1287}#) + (if (null? #{m2\ 1287}#) + #{m1\ 1286}# + (append #{m1\ 1286}# #{m2\ 1287}#)))) + (#{join-wraps\ 428}# + (lambda (#{w1\ 1290}# #{w2\ 1291}#) (begin - (let ((#{m1\ 1297}# (car #{w1\ 1291}#)) - (#{s1\ 1298}# (cdr #{w1\ 1291}#))) - (if (null? #{m1\ 1297}#) - (if (null? #{s1\ 1298}#) - #{w2\ 1292}# - (cons (car #{w2\ 1292}#) - (#{smart-append\ 425}# - #{s1\ 1298}# - (cdr #{w2\ 1292}#)))) - (cons (#{smart-append\ 425}# - #{m1\ 1297}# - (car #{w2\ 1292}#)) - (#{smart-append\ 425}# - #{s1\ 1298}# - (cdr #{w2\ 1292}#)))))))) - (#{join-marks\ 429}# - (lambda (#{m1\ 1307}# #{m2\ 1308}#) - (#{smart-append\ 425}# #{m1\ 1307}# #{m2\ 1308}#))) - (#{same-marks?\ 431}# - (lambda (#{x\ 1311}# #{y\ 1312}#) + (let ((#{m1\ 1296}# (car #{w1\ 1290}#)) + (#{s1\ 1297}# (cdr #{w1\ 1290}#))) + (if (null? #{m1\ 1296}#) + (if (null? #{s1\ 1297}#) + #{w2\ 1291}# + (cons (car #{w2\ 1291}#) + (#{smart-append\ 426}# + #{s1\ 1297}# + (cdr #{w2\ 1291}#)))) + (cons (#{smart-append\ 426}# + #{m1\ 1296}# + (car #{w2\ 1291}#)) + (#{smart-append\ 426}# + #{s1\ 1297}# + (cdr #{w2\ 1291}#)))))))) + (#{join-marks\ 430}# + (lambda (#{m1\ 1306}# #{m2\ 1307}#) + (#{smart-append\ 426}# #{m1\ 1306}# #{m2\ 1307}#))) + (#{same-marks?\ 432}# + (lambda (#{x\ 1310}# #{y\ 1311}#) (begin - (let ((#{t\ 1317}# (eq? #{x\ 1311}# #{y\ 1312}#))) - (if #{t\ 1317}# - #{t\ 1317}# - (if (not (null? #{x\ 1311}#)) - (if (not (null? #{y\ 1312}#)) - (if (eq? (car #{x\ 1311}#) (car #{y\ 1312}#)) - (#{same-marks?\ 431}# - (cdr #{x\ 1311}#) - (cdr #{y\ 1312}#)) + (let ((#{t\ 1316}# (eq? #{x\ 1310}# #{y\ 1311}#))) + (if #{t\ 1316}# + #{t\ 1316}# + (if (not (null? #{x\ 1310}#)) + (if (not (null? #{y\ 1311}#)) + (if (eq? (car #{x\ 1310}#) (car #{y\ 1311}#)) + (#{same-marks?\ 432}# + (cdr #{x\ 1310}#) + (cdr #{y\ 1311}#)) #f) #f) #f)))))) - (#{id-var-name\ 433}# - (lambda (#{id\ 1323}# #{w\ 1324}#) + (#{id-var-name\ 434}# + (lambda (#{id\ 1322}# #{w\ 1323}#) (letrec* - ((#{search\ 1329}# - (lambda (#{sym\ 1345}# #{subst\ 1346}# #{marks\ 1347}#) - (if (null? #{subst\ 1346}#) - (values #f #{marks\ 1347}#) + ((#{search\ 1328}# + (lambda (#{sym\ 1344}# #{subst\ 1345}# #{marks\ 1346}#) + (if (null? #{subst\ 1345}#) + (values #f #{marks\ 1346}#) (begin - (let ((#{fst\ 1352}# (car #{subst\ 1346}#))) - (if (eq? #{fst\ 1352}# 'shift) - (#{search\ 1329}# - #{sym\ 1345}# - (cdr #{subst\ 1346}#) - (cdr #{marks\ 1347}#)) + (let ((#{fst\ 1351}# (car #{subst\ 1345}#))) + (if (eq? #{fst\ 1351}# 'shift) + (#{search\ 1328}# + #{sym\ 1344}# + (cdr #{subst\ 1345}#) + (cdr #{marks\ 1346}#)) (begin - (let ((#{symnames\ 1354}# - (#{ribcage-symnames\ 401}# - #{fst\ 1352}#))) - (if (vector? #{symnames\ 1354}#) - (#{search-vector-rib\ 1333}# - #{sym\ 1345}# - #{subst\ 1346}# - #{marks\ 1347}# - #{symnames\ 1354}# - #{fst\ 1352}#) - (#{search-list-rib\ 1331}# - #{sym\ 1345}# - #{subst\ 1346}# - #{marks\ 1347}# - #{symnames\ 1354}# - #{fst\ 1352}#)))))))))) - (#{search-list-rib\ 1331}# - (lambda (#{sym\ 1355}# - #{subst\ 1356}# - #{marks\ 1357}# - #{symnames\ 1358}# - #{ribcage\ 1359}#) + (let ((#{symnames\ 1353}# + (#{ribcage-symnames\ 402}# + #{fst\ 1351}#))) + (if (vector? #{symnames\ 1353}#) + (#{search-vector-rib\ 1332}# + #{sym\ 1344}# + #{subst\ 1345}# + #{marks\ 1346}# + #{symnames\ 1353}# + #{fst\ 1351}#) + (#{search-list-rib\ 1330}# + #{sym\ 1344}# + #{subst\ 1345}# + #{marks\ 1346}# + #{symnames\ 1353}# + #{fst\ 1351}#)))))))))) + (#{search-list-rib\ 1330}# + (lambda (#{sym\ 1354}# + #{subst\ 1355}# + #{marks\ 1356}# + #{symnames\ 1357}# + #{ribcage\ 1358}#) (letrec* - ((#{f\ 1368}# - (lambda (#{symnames\ 1369}# #{i\ 1370}#) - (if (null? #{symnames\ 1369}#) - (#{search\ 1329}# - #{sym\ 1355}# - (cdr #{subst\ 1356}#) - #{marks\ 1357}#) - (if (if (eq? (car #{symnames\ 1369}#) - #{sym\ 1355}#) - (#{same-marks?\ 431}# - #{marks\ 1357}# + ((#{f\ 1367}# + (lambda (#{symnames\ 1368}# #{i\ 1369}#) + (if (null? #{symnames\ 1368}#) + (#{search\ 1328}# + #{sym\ 1354}# + (cdr #{subst\ 1355}#) + #{marks\ 1356}#) + (if (if (eq? (car #{symnames\ 1368}#) + #{sym\ 1354}#) + (#{same-marks?\ 432}# + #{marks\ 1356}# (list-ref - (#{ribcage-marks\ 403}# - #{ribcage\ 1359}#) - #{i\ 1370}#)) + (#{ribcage-marks\ 404}# + #{ribcage\ 1358}#) + #{i\ 1369}#)) #f) (values (list-ref - (#{ribcage-labels\ 405}# #{ribcage\ 1359}#) - #{i\ 1370}#) - #{marks\ 1357}#) - (#{f\ 1368}# - (cdr #{symnames\ 1369}#) - (#{fx+\ 282}# #{i\ 1370}# 1))))))) - (begin (#{f\ 1368}# #{symnames\ 1358}# 0))))) - (#{search-vector-rib\ 1333}# - (lambda (#{sym\ 1378}# - #{subst\ 1379}# - #{marks\ 1380}# - #{symnames\ 1381}# - #{ribcage\ 1382}#) + (#{ribcage-labels\ 406}# #{ribcage\ 1358}#) + #{i\ 1369}#) + #{marks\ 1356}#) + (#{f\ 1367}# + (cdr #{symnames\ 1368}#) + (#{fx+\ 283}# #{i\ 1369}# 1))))))) + (begin (#{f\ 1367}# #{symnames\ 1357}# 0))))) + (#{search-vector-rib\ 1332}# + (lambda (#{sym\ 1377}# + #{subst\ 1378}# + #{marks\ 1379}# + #{symnames\ 1380}# + #{ribcage\ 1381}#) (begin - (let ((#{n\ 1389}# (vector-length #{symnames\ 1381}#))) + (let ((#{n\ 1388}# (vector-length #{symnames\ 1380}#))) (letrec* - ((#{f\ 1392}# - (lambda (#{i\ 1393}#) - (if (#{fx=\ 286}# #{i\ 1393}# #{n\ 1389}#) - (#{search\ 1329}# - #{sym\ 1378}# - (cdr #{subst\ 1379}#) - #{marks\ 1380}#) + ((#{f\ 1391}# + (lambda (#{i\ 1392}#) + (if (#{fx=\ 287}# #{i\ 1392}# #{n\ 1388}#) + (#{search\ 1328}# + #{sym\ 1377}# + (cdr #{subst\ 1378}#) + #{marks\ 1379}#) (if (if (eq? (vector-ref - #{symnames\ 1381}# - #{i\ 1393}#) - #{sym\ 1378}#) - (#{same-marks?\ 431}# - #{marks\ 1380}# + #{symnames\ 1380}# + #{i\ 1392}#) + #{sym\ 1377}#) + (#{same-marks?\ 432}# + #{marks\ 1379}# (vector-ref - (#{ribcage-marks\ 403}# - #{ribcage\ 1382}#) - #{i\ 1393}#)) + (#{ribcage-marks\ 404}# + #{ribcage\ 1381}#) + #{i\ 1392}#)) #f) (values (vector-ref - (#{ribcage-labels\ 405}# - #{ribcage\ 1382}#) - #{i\ 1393}#) - #{marks\ 1380}#) - (#{f\ 1392}# - (#{fx+\ 282}# #{i\ 1393}# 1))))))) - (begin (#{f\ 1392}# 0)))))))) + (#{ribcage-labels\ 406}# + #{ribcage\ 1381}#) + #{i\ 1392}#) + #{marks\ 1379}#) + (#{f\ 1391}# + (#{fx+\ 283}# #{i\ 1392}# 1))))))) + (begin (#{f\ 1391}# 0)))))))) (begin - (if (symbol? #{id\ 1323}#) + (if (symbol? #{id\ 1322}#) (begin - (let ((#{t\ 1403}# + (let ((#{t\ 1402}# (call-with-values (lambda () - (#{search\ 1329}# - #{id\ 1323}# - (cdr #{w\ 1324}#) - (car #{w\ 1324}#))) - (lambda (#{x\ 1407}# . #{ignore\ 1408}#) - #{x\ 1407}#)))) - (if #{t\ 1403}# #{t\ 1403}# #{id\ 1323}#))) - (if (#{syntax-object?\ 345}# #{id\ 1323}#) + (#{search\ 1328}# + #{id\ 1322}# + (cdr #{w\ 1323}#) + (car #{w\ 1323}#))) + (lambda (#{x\ 1406}# . #{ignore\ 1407}#) + #{x\ 1406}#)))) + (if #{t\ 1402}# #{t\ 1402}# #{id\ 1322}#))) + (if (#{syntax-object?\ 346}# #{id\ 1322}#) (begin - (let ((#{id\ 1416}# - (#{syntax-object-expression\ 347}# - #{id\ 1323}#)) - (#{w1\ 1417}# - (#{syntax-object-wrap\ 349}# #{id\ 1323}#))) + (let ((#{id\ 1415}# + (#{syntax-object-expression\ 348}# + #{id\ 1322}#)) + (#{w1\ 1416}# + (#{syntax-object-wrap\ 350}# #{id\ 1322}#))) (begin - (let ((#{marks\ 1419}# - (#{join-marks\ 429}# - (car #{w\ 1324}#) - (car #{w1\ 1417}#)))) + (let ((#{marks\ 1418}# + (#{join-marks\ 430}# + (car #{w\ 1323}#) + (car #{w1\ 1416}#)))) (call-with-values (lambda () - (#{search\ 1329}# - #{id\ 1416}# - (cdr #{w\ 1324}#) - #{marks\ 1419}#)) - (lambda (#{new-id\ 1423}# #{marks\ 1424}#) + (#{search\ 1328}# + #{id\ 1415}# + (cdr #{w\ 1323}#) + #{marks\ 1418}#)) + (lambda (#{new-id\ 1422}# #{marks\ 1423}#) (begin - (let ((#{t\ 1429}# #{new-id\ 1423}#)) - (if #{t\ 1429}# - #{t\ 1429}# + (let ((#{t\ 1428}# #{new-id\ 1422}#)) + (if #{t\ 1428}# + #{t\ 1428}# (begin - (let ((#{t\ 1432}# + (let ((#{t\ 1431}# (call-with-values (lambda () - (#{search\ 1329}# - #{id\ 1416}# - (cdr #{w1\ 1417}#) - #{marks\ 1424}#)) - (lambda (#{x\ 1435}# + (#{search\ 1328}# + #{id\ 1415}# + (cdr #{w1\ 1416}#) + #{marks\ 1423}#)) + (lambda (#{x\ 1434}# . - #{ignore\ 1436}#) - #{x\ 1435}#)))) - (if #{t\ 1432}# - #{t\ 1432}# - #{id\ 1416}#)))))))))))) + #{ignore\ 1435}#) + #{x\ 1434}#)))) + (if #{t\ 1431}# + #{t\ 1431}# + #{id\ 1415}#)))))))))))) (syntax-violation 'id-var-name "invalid id" - #{id\ 1323}#))))))) - (#{free-id=?\ 435}# - (lambda (#{i\ 1441}# #{j\ 1442}#) + #{id\ 1322}#))))))) + (#{free-id=?\ 436}# + (lambda (#{i\ 1440}# #{j\ 1441}#) (if (eq? (begin - (let ((#{x\ 1448}# #{i\ 1441}#)) - (if (#{syntax-object?\ 345}# #{x\ 1448}#) - (#{syntax-object-expression\ 347}# #{x\ 1448}#) - #{x\ 1448}#))) + (let ((#{x\ 1447}# #{i\ 1440}#)) + (if (#{syntax-object?\ 346}# #{x\ 1447}#) + (#{syntax-object-expression\ 348}# #{x\ 1447}#) + #{x\ 1447}#))) (begin - (let ((#{x\ 1451}# #{j\ 1442}#)) - (if (#{syntax-object?\ 345}# #{x\ 1451}#) - (#{syntax-object-expression\ 347}# #{x\ 1451}#) - #{x\ 1451}#)))) - (eq? (#{id-var-name\ 433}# #{i\ 1441}# '(())) - (#{id-var-name\ 433}# #{j\ 1442}# '(()))) + (let ((#{x\ 1450}# #{j\ 1441}#)) + (if (#{syntax-object?\ 346}# #{x\ 1450}#) + (#{syntax-object-expression\ 348}# #{x\ 1450}#) + #{x\ 1450}#)))) + (eq? (#{id-var-name\ 434}# #{i\ 1440}# '(())) + (#{id-var-name\ 434}# #{j\ 1441}# '(()))) #f))) - (#{bound-id=?\ 437}# - (lambda (#{i\ 1455}# #{j\ 1456}#) - (if (if (#{syntax-object?\ 345}# #{i\ 1455}#) - (#{syntax-object?\ 345}# #{j\ 1456}#) + (#{bound-id=?\ 438}# + (lambda (#{i\ 1454}# #{j\ 1455}#) + (if (if (#{syntax-object?\ 346}# #{i\ 1454}#) + (#{syntax-object?\ 346}# #{j\ 1455}#) #f) - (if (eq? (#{syntax-object-expression\ 347}# #{i\ 1455}#) - (#{syntax-object-expression\ 347}# #{j\ 1456}#)) - (#{same-marks?\ 431}# - (car (#{syntax-object-wrap\ 349}# #{i\ 1455}#)) - (car (#{syntax-object-wrap\ 349}# #{j\ 1456}#))) + (if (eq? (#{syntax-object-expression\ 348}# #{i\ 1454}#) + (#{syntax-object-expression\ 348}# #{j\ 1455}#)) + (#{same-marks?\ 432}# + (car (#{syntax-object-wrap\ 350}# #{i\ 1454}#)) + (car (#{syntax-object-wrap\ 350}# #{j\ 1455}#))) #f) - (eq? #{i\ 1455}# #{j\ 1456}#)))) - (#{valid-bound-ids?\ 439}# - (lambda (#{ids\ 1465}#) + (eq? #{i\ 1454}# #{j\ 1455}#)))) + (#{valid-bound-ids?\ 440}# + (lambda (#{ids\ 1464}#) (if (letrec* - ((#{all-ids?\ 1470}# - (lambda (#{ids\ 1471}#) + ((#{all-ids?\ 1469}# + (lambda (#{ids\ 1470}#) (begin - (let ((#{t\ 1474}# (null? #{ids\ 1471}#))) - (if #{t\ 1474}# - #{t\ 1474}# - (if (#{id?\ 379}# (car #{ids\ 1471}#)) - (#{all-ids?\ 1470}# (cdr #{ids\ 1471}#)) + (let ((#{t\ 1473}# (null? #{ids\ 1470}#))) + (if #{t\ 1473}# + #{t\ 1473}# + (if (#{id?\ 380}# (car #{ids\ 1470}#)) + (#{all-ids?\ 1469}# (cdr #{ids\ 1470}#)) #f))))))) - (begin (#{all-ids?\ 1470}# #{ids\ 1465}#))) - (#{distinct-bound-ids?\ 441}# #{ids\ 1465}#) + (begin (#{all-ids?\ 1469}# #{ids\ 1464}#))) + (#{distinct-bound-ids?\ 442}# #{ids\ 1464}#) #f))) - (#{distinct-bound-ids?\ 441}# - (lambda (#{ids\ 1479}#) + (#{distinct-bound-ids?\ 442}# + (lambda (#{ids\ 1478}#) (letrec* - ((#{distinct?\ 1483}# - (lambda (#{ids\ 1484}#) + ((#{distinct?\ 1482}# + (lambda (#{ids\ 1483}#) (begin - (let ((#{t\ 1487}# (null? #{ids\ 1484}#))) - (if #{t\ 1487}# - #{t\ 1487}# - (if (not (#{bound-id-member?\ 443}# - (car #{ids\ 1484}#) - (cdr #{ids\ 1484}#))) - (#{distinct?\ 1483}# (cdr #{ids\ 1484}#)) + (let ((#{t\ 1486}# (null? #{ids\ 1483}#))) + (if #{t\ 1486}# + #{t\ 1486}# + (if (not (#{bound-id-member?\ 444}# + (car #{ids\ 1483}#) + (cdr #{ids\ 1483}#))) + (#{distinct?\ 1482}# (cdr #{ids\ 1483}#)) #f))))))) - (begin (#{distinct?\ 1483}# #{ids\ 1479}#))))) - (#{bound-id-member?\ 443}# - (lambda (#{x\ 1491}# #{list\ 1492}#) - (if (not (null? #{list\ 1492}#)) + (begin (#{distinct?\ 1482}# #{ids\ 1478}#))))) + (#{bound-id-member?\ 444}# + (lambda (#{x\ 1490}# #{list\ 1491}#) + (if (not (null? #{list\ 1491}#)) (begin - (let ((#{t\ 1499}# - (#{bound-id=?\ 437}# - #{x\ 1491}# - (car #{list\ 1492}#)))) - (if #{t\ 1499}# - #{t\ 1499}# - (#{bound-id-member?\ 443}# - #{x\ 1491}# - (cdr #{list\ 1492}#))))) + (let ((#{t\ 1498}# + (#{bound-id=?\ 438}# + #{x\ 1490}# + (car #{list\ 1491}#)))) + (if #{t\ 1498}# + #{t\ 1498}# + (#{bound-id-member?\ 444}# + #{x\ 1490}# + (cdr #{list\ 1491}#))))) #f))) - (#{wrap\ 445}# - (lambda (#{x\ 1501}# #{w\ 1502}# #{defmod\ 1503}#) - (if (if (null? (car #{w\ 1502}#)) - (null? (cdr #{w\ 1502}#)) + (#{wrap\ 446}# + (lambda (#{x\ 1500}# #{w\ 1501}# #{defmod\ 1502}#) + (if (if (null? (car #{w\ 1501}#)) + (null? (cdr #{w\ 1501}#)) #f) - #{x\ 1501}# - (if (#{syntax-object?\ 345}# #{x\ 1501}#) - (#{make-syntax-object\ 343}# - (#{syntax-object-expression\ 347}# #{x\ 1501}#) - (#{join-wraps\ 427}# - #{w\ 1502}# - (#{syntax-object-wrap\ 349}# #{x\ 1501}#)) - (#{syntax-object-module\ 351}# #{x\ 1501}#)) - (if (null? #{x\ 1501}#) - #{x\ 1501}# - (#{make-syntax-object\ 343}# - #{x\ 1501}# - #{w\ 1502}# - #{defmod\ 1503}#)))))) - (#{source-wrap\ 447}# - (lambda (#{x\ 1518}# - #{w\ 1519}# - #{s\ 1520}# - #{defmod\ 1521}#) - (#{wrap\ 445}# - (#{decorate-source\ 299}# - #{x\ 1518}# - #{s\ 1520}#) - #{w\ 1519}# - #{defmod\ 1521}#))) - (#{chi-sequence\ 449}# - (lambda (#{body\ 1526}# - #{r\ 1527}# - #{w\ 1528}# - #{s\ 1529}# - #{mod\ 1530}#) - (#{build-sequence\ 333}# - #{s\ 1529}# + #{x\ 1500}# + (if (#{syntax-object?\ 346}# #{x\ 1500}#) + (#{make-syntax-object\ 344}# + (#{syntax-object-expression\ 348}# #{x\ 1500}#) + (#{join-wraps\ 428}# + #{w\ 1501}# + (#{syntax-object-wrap\ 350}# #{x\ 1500}#)) + (#{syntax-object-module\ 352}# #{x\ 1500}#)) + (if (null? #{x\ 1500}#) + #{x\ 1500}# + (#{make-syntax-object\ 344}# + #{x\ 1500}# + #{w\ 1501}# + #{defmod\ 1502}#)))))) + (#{source-wrap\ 448}# + (lambda (#{x\ 1517}# + #{w\ 1518}# + #{s\ 1519}# + #{defmod\ 1520}#) + (#{wrap\ 446}# + (#{decorate-source\ 300}# + #{x\ 1517}# + #{s\ 1519}#) + #{w\ 1518}# + #{defmod\ 1520}#))) + (#{chi-sequence\ 450}# + (lambda (#{body\ 1525}# + #{r\ 1526}# + #{w\ 1527}# + #{s\ 1528}# + #{mod\ 1529}#) + (#{build-sequence\ 334}# + #{s\ 1528}# (letrec* - ((#{dobody\ 1541}# - (lambda (#{body\ 1542}# - #{r\ 1543}# - #{w\ 1544}# - #{mod\ 1545}#) - (if (null? #{body\ 1542}#) + ((#{dobody\ 1540}# + (lambda (#{body\ 1541}# + #{r\ 1542}# + #{w\ 1543}# + #{mod\ 1544}#) + (if (null? #{body\ 1541}#) '() (begin - (let ((#{first\ 1547}# - (#{chi\ 461}# - (car #{body\ 1542}#) - #{r\ 1543}# - #{w\ 1544}# - #{mod\ 1545}#))) - (cons #{first\ 1547}# - (#{dobody\ 1541}# - (cdr #{body\ 1542}#) - #{r\ 1543}# - #{w\ 1544}# - #{mod\ 1545}#)))))))) + (let ((#{first\ 1546}# + (#{chi\ 460}# + (car #{body\ 1541}#) + #{r\ 1542}# + #{w\ 1543}# + #{mod\ 1544}#))) + (cons #{first\ 1546}# + (#{dobody\ 1540}# + (cdr #{body\ 1541}#) + #{r\ 1542}# + #{w\ 1543}# + #{mod\ 1544}#)))))))) (begin - (#{dobody\ 1541}# - #{body\ 1526}# - #{r\ 1527}# - #{w\ 1528}# - #{mod\ 1530}#)))))) - (#{chi-top-sequence\ 451}# - (lambda (#{body\ 1548}# - #{r\ 1549}# - #{w\ 1550}# - #{s\ 1551}# - #{m\ 1552}# - #{esew\ 1553}# - #{mod\ 1554}#) - (#{build-sequence\ 333}# - #{s\ 1551}# - (letrec* - ((#{dobody\ 1570}# - (lambda (#{body\ 1571}# - #{r\ 1572}# - #{w\ 1573}# - #{m\ 1574}# - #{esew\ 1575}# - #{mod\ 1576}# - #{out\ 1577}#) - (if (null? #{body\ 1571}#) - (reverse #{out\ 1577}#) - (#{dobody\ 1570}# - (cdr #{body\ 1571}#) - #{r\ 1572}# - #{w\ 1573}# - #{m\ 1574}# - #{esew\ 1575}# - #{mod\ 1576}# - (cons (#{chi-top\ 459}# - (car #{body\ 1571}#) - #{r\ 1572}# - #{w\ 1573}# - #{m\ 1574}# - #{esew\ 1575}# - #{mod\ 1576}#) - #{out\ 1577}#)))))) - (begin - (#{dobody\ 1570}# - #{body\ 1548}# - #{r\ 1549}# - #{w\ 1550}# - #{m\ 1552}# - #{esew\ 1553}# - #{mod\ 1554}# - '())))))) - (#{chi-install-global\ 453}# - (lambda (#{name\ 1578}# #{e\ 1579}#) - (#{build-global-definition\ 321}# + (#{dobody\ 1540}# + #{body\ 1525}# + #{r\ 1526}# + #{w\ 1527}# + #{mod\ 1529}#)))))) + (#{chi-top-sequence\ 452}# + (lambda (#{body\ 1547}# + #{r\ 1548}# + #{w\ 1549}# + #{s\ 1550}# + #{m\ 1551}# + #{esew\ 1552}# + #{mod\ 1553}#) + (letrec* + ((#{scan\ 1562}# + (lambda (#{body\ 1563}# + #{r\ 1564}# + #{w\ 1565}# + #{s\ 1566}# + #{m\ 1567}# + #{esew\ 1568}# + #{mod\ 1569}# + #{exps\ 1570}#) + (if (null? #{body\ 1563}#) + #{exps\ 1570}# + (call-with-values + (lambda () + (call-with-values + (lambda () + (begin + (let ((#{e\ 1583}# (car #{body\ 1563}#))) + (#{syntax-type\ 458}# + #{e\ 1583}# + #{r\ 1564}# + #{w\ 1565}# + (begin + (let ((#{t\ 1586}# + (#{source-annotation\ 361}# + #{e\ 1583}#))) + (if #{t\ 1586}# + #{t\ 1586}# + #{s\ 1566}#))) + #f + #{mod\ 1569}# + #f)))) + (lambda (#{type\ 1588}# + #{value\ 1589}# + #{e\ 1590}# + #{w\ 1591}# + #{s\ 1592}# + #{mod\ 1593}#) + (if (eqv? #{type\ 1588}# 'begin-form) + (let ((#{tmp\ 1601}# #{e\ 1590}#)) + (let ((#{tmp\ 1602}# + ($sc-dispatch #{tmp\ 1601}# '(_)))) + (if #{tmp\ 1602}# + (@apply + (lambda () #{exps\ 1570}#) + #{tmp\ 1602}#) + (let ((#{tmp\ 1603}# + ($sc-dispatch + #{tmp\ 1601}# + '(_ any . each-any)))) + (if #{tmp\ 1603}# + (@apply + (lambda (#{e1\ 1606}# #{e2\ 1607}#) + (#{scan\ 1562}# + (cons #{e1\ 1606}# + #{e2\ 1607}#) + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + #{m\ 1567}# + #{esew\ 1568}# + #{mod\ 1593}# + #{exps\ 1570}#)) + #{tmp\ 1603}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1601}#)))))) + (if (eqv? #{type\ 1588}# 'local-syntax-form) + (#{chi-local-syntax\ 470}# + #{value\ 1589}# + #{e\ 1590}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + #{mod\ 1593}# + (lambda (#{body\ 1610}# + #{r\ 1611}# + #{w\ 1612}# + #{s\ 1613}# + #{mod\ 1614}#) + (#{scan\ 1562}# + #{body\ 1610}# + #{r\ 1611}# + #{w\ 1612}# + #{s\ 1613}# + #{m\ 1567}# + #{esew\ 1568}# + #{mod\ 1614}# + #{exps\ 1570}#))) + (if (eqv? #{type\ 1588}# 'eval-when-form) + (let ((#{tmp\ 1621}# #{e\ 1590}#)) + (let ((#{tmp\ 1622}# + ($sc-dispatch + #{tmp\ 1621}# + '(_ each-any any . each-any)))) + (if #{tmp\ 1622}# + (@apply + (lambda (#{x\ 1626}# + #{e1\ 1627}# + #{e2\ 1628}#) + (begin + (let ((#{when-list\ 1631}# + (#{chi-when-list\ 456}# + #{e\ 1590}# + #{x\ 1626}# + #{w\ 1591}#)) + (#{body\ 1632}# + (cons #{e1\ 1627}# + #{e2\ 1628}#))) + (if (eq? #{m\ 1567}# 'e) + (if (memq 'eval + #{when-list\ 1631}#) + (#{scan\ 1562}# + #{body\ 1632}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + (if (memq 'expand + #{when-list\ 1631}#) + 'c&e + 'e) + '(eval) + #{mod\ 1593}# + #{exps\ 1570}#) + (begin + (if (memq 'expand + #{when-list\ 1631}#) + (#{top-level-eval-hook\ 291}# + (#{chi-top-sequence\ 452}# + #{body\ 1632}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + 'e + '(eval) + #{mod\ 1593}#) + #{mod\ 1593}#)) + #{exps\ 1570}#)) + (if (memq 'load + #{when-list\ 1631}#) + (if (begin + (let ((#{t\ 1641}# + (memq 'compile + #{when-list\ 1631}#))) + (if #{t\ 1641}# + #{t\ 1641}# + (begin + (let ((#{t\ 1644}# + (memq 'expand + #{when-list\ 1631}#))) + (if #{t\ 1644}# + #{t\ 1644}# + (if (eq? #{m\ 1567}# + 'c&e) + (memq 'eval + #{when-list\ 1631}#) + #f))))))) + (#{scan\ 1562}# + #{body\ 1632}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + 'c&e + '(compile load) + #{mod\ 1593}# + #{exps\ 1570}#) + (if (if (eq? #{m\ 1567}# + 'c) + #t + (eq? #{m\ 1567}# + 'c&e)) + (#{scan\ 1562}# + #{body\ 1632}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + 'c + '(load) + #{mod\ 1593}# + #{exps\ 1570}#) + #{exps\ 1570}#)) + (if (begin + (let ((#{t\ 1652}# + (memq 'compile + #{when-list\ 1631}#))) + (if #{t\ 1652}# + #{t\ 1652}# + (begin + (let ((#{t\ 1655}# + (memq 'expand + #{when-list\ 1631}#))) + (if #{t\ 1655}# + #{t\ 1655}# + (if (eq? #{m\ 1567}# + 'c&e) + (memq 'eval + #{when-list\ 1631}#) + #f))))))) + (begin + (#{top-level-eval-hook\ 291}# + (#{chi-top-sequence\ 452}# + #{body\ 1632}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + 'e + '(eval) + #{mod\ 1593}#) + #{mod\ 1593}#) + #{exps\ 1570}#) + #{exps\ 1570}#)))))) + #{tmp\ 1622}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1621}#)))) + (if (eqv? #{type\ 1588}# + 'define-syntax-form) + (begin + (let ((#{n\ 1663}# + (#{id-var-name\ 434}# + #{value\ 1589}# + #{w\ 1591}#)) + (#{r\ 1664}# + (#{macros-only-env\ 372}# + #{r\ 1564}#))) + (if (eqv? #{m\ 1567}# 'c) + (if (memq 'compile #{esew\ 1568}#) + (begin + (let ((#{e\ 1667}# + (#{chi-install-global\ 454}# + #{n\ 1663}# + (#{chi\ 460}# + #{e\ 1590}# + #{r\ 1664}# + #{w\ 1591}# + #{mod\ 1593}#)))) + (begin + (#{top-level-eval-hook\ 291}# + #{e\ 1667}# + #{mod\ 1593}#) + (if (memq 'load + #{esew\ 1568}#) + (cons #{e\ 1667}# + #{exps\ 1570}#) + #{exps\ 1570}#)))) + (if (memq 'load #{esew\ 1568}#) + (cons (#{chi-install-global\ 454}# + #{n\ 1663}# + (#{chi\ 460}# + #{e\ 1590}# + #{r\ 1664}# + #{w\ 1591}# + #{mod\ 1593}#)) + #{exps\ 1570}#) + #{exps\ 1570}#)) + (if (eqv? #{m\ 1567}# 'c&e) + (begin + (let ((#{e\ 1670}# + (#{chi-install-global\ 454}# + #{n\ 1663}# + (#{chi\ 460}# + #{e\ 1590}# + #{r\ 1664}# + #{w\ 1591}# + #{mod\ 1593}#)))) + (begin + (#{top-level-eval-hook\ 291}# + #{e\ 1670}# + #{mod\ 1593}#) + (cons #{e\ 1670}# + #{exps\ 1570}#)))) + (begin + (if (memq 'eval #{esew\ 1568}#) + (#{top-level-eval-hook\ 291}# + (#{chi-install-global\ 454}# + #{n\ 1663}# + (#{chi\ 460}# + #{e\ 1590}# + #{r\ 1664}# + #{w\ 1591}# + #{mod\ 1593}#)) + #{mod\ 1593}#)) + #{exps\ 1570}#))))) + (if (eqv? #{type\ 1588}# 'define-form) + (begin + (let ((#{n\ 1675}# + (#{id-var-name\ 434}# + #{value\ 1589}# + #{w\ 1591}#))) + (begin + (let ((#{type\ 1677}# + (car (#{lookup\ 374}# + #{n\ 1675}# + #{r\ 1564}# + #{mod\ 1593}#)))) + (if (if (eqv? #{type\ 1677}# + 'global) + #t + (if (eqv? #{type\ 1677}# + 'core) + #t + (if (eqv? #{type\ 1677}# + 'macro) + #t + (eqv? #{type\ 1677}# + 'module-ref)))) + (begin + (if (if (if (eq? #{m\ 1567}# + 'c) + #t + (eq? #{m\ 1567}# + 'c&e)) + (if (not (module-local-variable + (current-module) + #{n\ 1675}#)) + (current-module) + #f) + #f) + (begin + (let ((#{old\ 1684}# + (module-variable + (current-module) + #{n\ 1675}#))) + (if (if (variable? + #{old\ 1684}#) + (variable-bound? + #{old\ 1684}#) + #f) + (module-define! + (current-module) + #{n\ 1675}# + (variable-ref + #{old\ 1684}#)) + (module-add! + (current-module) + #{n\ 1675}# + (make-undefined-variable)))))) + (cons (if (eq? #{m\ 1567}# + 'c&e) + (begin + (let ((#{x\ 1688}# + (#{build-global-definition\ 322}# + #{s\ 1592}# + #{n\ 1675}# + (#{chi\ 460}# + #{e\ 1590}# + #{r\ 1564}# + #{w\ 1591}# + #{mod\ 1593}#)))) + (begin + (#{top-level-eval-hook\ 291}# + #{x\ 1688}# + #{mod\ 1593}#) + #{x\ 1688}#))) + (lambda () + (#{build-global-definition\ 322}# + #{s\ 1592}# + #{n\ 1675}# + (#{chi\ 460}# + #{e\ 1590}# + #{r\ 1564}# + #{w\ 1591}# + #{mod\ 1593}#)))) + #{exps\ 1570}#)) + (if (eqv? #{type\ 1677}# + 'displaced-lexical) + (syntax-violation + #f + "identifier out of context" + #{e\ 1590}# + (#{wrap\ 446}# + #{value\ 1589}# + #{w\ 1591}# + #{mod\ 1593}#)) + (syntax-violation + #f + "cannot define keyword at top level" + #{e\ 1590}# + (#{wrap\ 446}# + #{value\ 1589}# + #{w\ 1591}# + #{mod\ 1593}#)))))))) + (cons (if (eq? #{m\ 1567}# 'c&e) + (begin + (let ((#{x\ 1693}# + (#{chi-expr\ 462}# + #{type\ 1588}# + #{value\ 1589}# + #{e\ 1590}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + #{mod\ 1593}#))) + (begin + (#{top-level-eval-hook\ 291}# + #{x\ 1693}# + #{mod\ 1593}#) + #{x\ 1693}#))) + (lambda () + (#{chi-expr\ 462}# + #{type\ 1588}# + #{value\ 1589}# + #{e\ 1590}# + #{r\ 1564}# + #{w\ 1591}# + #{s\ 1592}# + #{mod\ 1593}#))) + #{exps\ 1570}#))))))))) + (lambda (#{exps\ 1694}#) + (#{scan\ 1562}# + (cdr #{body\ 1563}#) + #{r\ 1564}# + #{w\ 1565}# + #{s\ 1566}# + #{m\ 1567}# + #{esew\ 1568}# + #{mod\ 1569}# + #{exps\ 1694}#))))))) + (begin + (call-with-values + (lambda () + (#{scan\ 1562}# + #{body\ 1547}# + #{r\ 1548}# + #{w\ 1549}# + #{s\ 1550}# + #{m\ 1551}# + #{esew\ 1552}# + #{mod\ 1553}# + '())) + (lambda (#{exps\ 1696}#) + (if (null? #{exps\ 1696}#) + (#{build-void\ 304}# #{s\ 1550}#) + (#{build-sequence\ 334}# + #{s\ 1550}# + (letrec* + ((#{lp\ 1701}# + (lambda (#{in\ 1702}# #{out\ 1703}#) + (if (null? #{in\ 1702}#) + #{out\ 1703}# + (begin + (let ((#{e\ 1705}# (car #{in\ 1702}#))) + (#{lp\ 1701}# + (cdr #{in\ 1702}#) + (cons (if (procedure? #{e\ 1705}#) + (#{e\ 1705}#) + #{e\ 1705}#) + #{out\ 1703}#)))))))) + (begin (#{lp\ 1701}# #{exps\ 1696}# '()))))))))))) + (#{chi-install-global\ 454}# + (lambda (#{name\ 1706}# #{e\ 1707}#) + (#{build-global-definition\ 322}# #f - #{name\ 1578}# - (#{build-application\ 305}# + #{name\ 1706}# + (#{build-application\ 306}# #f - (#{build-primref\ 329}# + (#{build-primref\ 330}# #f 'make-syntax-transformer) - (list (#{build-data\ 331}# #f #{name\ 1578}#) - (#{build-data\ 331}# #f 'macro) - #{e\ 1579}#))))) - (#{chi-when-list\ 455}# - (lambda (#{e\ 1587}# #{when-list\ 1588}# #{w\ 1589}#) + (list (#{build-data\ 332}# #f #{name\ 1706}#) + (#{build-data\ 332}# #f 'macro) + #{e\ 1707}#))))) + (#{chi-when-list\ 456}# + (lambda (#{e\ 1715}# #{when-list\ 1716}# #{w\ 1717}#) (letrec* - ((#{f\ 1596}# - (lambda (#{when-list\ 1597}# #{situations\ 1598}#) - (if (null? #{when-list\ 1597}#) - #{situations\ 1598}# - (#{f\ 1596}# - (cdr #{when-list\ 1597}#) + ((#{f\ 1724}# + (lambda (#{when-list\ 1725}# #{situations\ 1726}#) + (if (null? #{when-list\ 1725}#) + #{situations\ 1726}# + (#{f\ 1724}# + (cdr #{when-list\ 1725}#) (cons (begin - (let ((#{x\ 1600}# (car #{when-list\ 1597}#))) - (if (#{free-id=?\ 435}# - #{x\ 1600}# + (let ((#{x\ 1728}# (car #{when-list\ 1725}#))) + (if (#{free-id=?\ 436}# + #{x\ 1728}# '#(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i1599")) + #(ribcage #(x) #((top)) #("i1727")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) - #("i1593" "i1594" "i1595")) + #("i1721" "i1722" "i1723")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) - #("i1590" "i1591" "i1592")) + #("i1718" "i1719" "i1720")) #(ribcage (lambda-var-list gen-var @@ -1216,7 +1630,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -1472,60 +1885,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -1534,94 +1946,93 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'compile - (if (#{free-id=?\ 435}# - #{x\ 1600}# + (if (#{free-id=?\ 436}# + #{x\ 1728}# '#(syntax-object load ((top) @@ -1631,17 +2042,17 @@ #(ribcage #(x) #((top)) - #("i1599")) + #("i1727")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) - #("i1593" "i1594" "i1595")) + #("i1721" "i1722" "i1723")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) - #("i1590" "i1591" "i1592")) + #("i1718" "i1719" "i1720")) #(ribcage (lambda-var-list gen-var @@ -1659,7 +2070,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -1915,60 +2325,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -1977,94 +2386,93 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'load - (if (#{free-id=?\ 435}# - #{x\ 1600}# + (if (#{free-id=?\ 436}# + #{x\ 1728}# '#(syntax-object eval ((top) @@ -2074,17 +2482,17 @@ #(ribcage #(x) #((top)) - #("i1599")) + #("i1727")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) - #("i1593" "i1594" "i1595")) + #("i1721" "i1722" "i1723")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) - #("i1590" "i1591" "i1592")) + #("i1718" "i1719" "i1720")) #(ribcage (lambda-var-list gen-var @@ -2102,7 +2510,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -2358,60 +2765,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -2420,94 +2826,93 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'eval - (if (#{free-id=?\ 435}# - #{x\ 1600}# + (if (#{free-id=?\ 436}# + #{x\ 1728}# '#(syntax-object expand ((top) @@ -2517,17 +2922,17 @@ #(ribcage #(x) #((top)) - #("i1599")) + #("i1727")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) - #("i1593" "i1594" "i1595")) + #("i1721" "i1722" "i1723")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) - #("i1590" "i1591" "i1592")) + #("i1718" "i1719" "i1720")) #(ribcage (lambda-var-list gen-var @@ -2545,7 +2950,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -2801,60 +3205,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -2863,333 +3266,332 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'expand (syntax-violation 'eval-when "invalid situation" - #{e\ 1587}# - (#{wrap\ 445}# - #{x\ 1600}# - #{w\ 1589}# + #{e\ 1715}# + (#{wrap\ 446}# + #{x\ 1728}# + #{w\ 1717}# #f)))))))) - #{situations\ 1598}#)))))) - (begin (#{f\ 1596}# #{when-list\ 1588}# '()))))) - (#{syntax-type\ 457}# - (lambda (#{e\ 1610}# - #{r\ 1611}# - #{w\ 1612}# - #{s\ 1613}# - #{rib\ 1614}# - #{mod\ 1615}# - #{for-car?\ 1616}#) - (if (symbol? #{e\ 1610}#) + #{situations\ 1726}#)))))) + (begin (#{f\ 1724}# #{when-list\ 1716}# '()))))) + (#{syntax-type\ 458}# + (lambda (#{e\ 1738}# + #{r\ 1739}# + #{w\ 1740}# + #{s\ 1741}# + #{rib\ 1742}# + #{mod\ 1743}# + #{for-car?\ 1744}#) + (if (symbol? #{e\ 1738}#) (begin - (let ((#{n\ 1628}# - (#{id-var-name\ 433}# #{e\ 1610}# #{w\ 1612}#))) + (let ((#{n\ 1756}# + (#{id-var-name\ 434}# #{e\ 1738}# #{w\ 1740}#))) (begin - (let ((#{b\ 1630}# - (#{lookup\ 373}# - #{n\ 1628}# - #{r\ 1611}# - #{mod\ 1615}#))) + (let ((#{b\ 1758}# + (#{lookup\ 374}# + #{n\ 1756}# + #{r\ 1739}# + #{mod\ 1743}#))) (begin - (let ((#{type\ 1632}# (car #{b\ 1630}#))) - (if (eqv? #{type\ 1632}# 'lexical) + (let ((#{type\ 1760}# (car #{b\ 1758}#))) + (if (eqv? #{type\ 1760}# 'lexical) (values - #{type\ 1632}# - (cdr #{b\ 1630}#) - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{type\ 1632}# 'global) + #{type\ 1760}# + (cdr #{b\ 1758}#) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{type\ 1760}# 'global) (values - #{type\ 1632}# - #{n\ 1628}# - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{type\ 1632}# 'macro) - (if #{for-car?\ 1616}# + #{type\ 1760}# + #{n\ 1756}# + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{type\ 1760}# 'macro) + (if #{for-car?\ 1744}# (values - #{type\ 1632}# - (cdr #{b\ 1630}#) - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (#{syntax-type\ 457}# - (#{chi-macro\ 467}# - (cdr #{b\ 1630}#) - #{e\ 1610}# - #{r\ 1611}# - #{w\ 1612}# - #{s\ 1613}# - #{rib\ 1614}# - #{mod\ 1615}#) - #{r\ 1611}# + #{type\ 1760}# + (cdr #{b\ 1758}#) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (#{syntax-type\ 458}# + (#{chi-macro\ 466}# + (cdr #{b\ 1758}#) + #{e\ 1738}# + #{r\ 1739}# + #{w\ 1740}# + #{s\ 1741}# + #{rib\ 1742}# + #{mod\ 1743}#) + #{r\ 1739}# '(()) - #{s\ 1613}# - #{rib\ 1614}# - #{mod\ 1615}# + #{s\ 1741}# + #{rib\ 1742}# + #{mod\ 1743}# #f)) (values - #{type\ 1632}# - (cdr #{b\ 1630}#) - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#)))))))))) - (if (pair? #{e\ 1610}#) + #{type\ 1760}# + (cdr #{b\ 1758}#) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#)))))))))) + (if (pair? #{e\ 1738}#) (begin - (let ((#{first\ 1646}# (car #{e\ 1610}#))) + (let ((#{first\ 1774}# (car #{e\ 1738}#))) (call-with-values (lambda () - (#{syntax-type\ 457}# - #{first\ 1646}# - #{r\ 1611}# - #{w\ 1612}# - #{s\ 1613}# - #{rib\ 1614}# - #{mod\ 1615}# + (#{syntax-type\ 458}# + #{first\ 1774}# + #{r\ 1739}# + #{w\ 1740}# + #{s\ 1741}# + #{rib\ 1742}# + #{mod\ 1743}# #t)) - (lambda (#{ftype\ 1647}# - #{fval\ 1648}# - #{fe\ 1649}# - #{fw\ 1650}# - #{fs\ 1651}# - #{fmod\ 1652}#) - (if (eqv? #{ftype\ 1647}# 'lexical) + (lambda (#{ftype\ 1775}# + #{fval\ 1776}# + #{fe\ 1777}# + #{fw\ 1778}# + #{fs\ 1779}# + #{fmod\ 1780}#) + (if (eqv? #{ftype\ 1775}# 'lexical) (values 'lexical-call - #{fval\ 1648}# - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{ftype\ 1647}# 'global) + #{fval\ 1776}# + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{ftype\ 1775}# 'global) (values 'global-call - (#{make-syntax-object\ 343}# - #{fval\ 1648}# - #{w\ 1612}# - #{fmod\ 1652}#) - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{ftype\ 1647}# 'macro) - (#{syntax-type\ 457}# - (#{chi-macro\ 467}# - #{fval\ 1648}# - #{e\ 1610}# - #{r\ 1611}# - #{w\ 1612}# - #{s\ 1613}# - #{rib\ 1614}# - #{mod\ 1615}#) - #{r\ 1611}# + (#{make-syntax-object\ 344}# + #{fval\ 1776}# + #{w\ 1740}# + #{fmod\ 1780}#) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{ftype\ 1775}# 'macro) + (#{syntax-type\ 458}# + (#{chi-macro\ 466}# + #{fval\ 1776}# + #{e\ 1738}# + #{r\ 1739}# + #{w\ 1740}# + #{s\ 1741}# + #{rib\ 1742}# + #{mod\ 1743}#) + #{r\ 1739}# '(()) - #{s\ 1613}# - #{rib\ 1614}# - #{mod\ 1615}# - #{for-car?\ 1616}#) - (if (eqv? #{ftype\ 1647}# 'module-ref) + #{s\ 1741}# + #{rib\ 1742}# + #{mod\ 1743}# + #{for-car?\ 1744}#) + (if (eqv? #{ftype\ 1775}# 'module-ref) (call-with-values (lambda () - (#{fval\ 1648}# - #{e\ 1610}# - #{r\ 1611}# - #{w\ 1612}#)) - (lambda (#{e\ 1664}# - #{r\ 1665}# - #{w\ 1666}# - #{s\ 1667}# - #{mod\ 1668}#) - (#{syntax-type\ 457}# - #{e\ 1664}# - #{r\ 1665}# - #{w\ 1666}# - #{s\ 1667}# - #{rib\ 1614}# - #{mod\ 1668}# - #{for-car?\ 1616}#))) - (if (eqv? #{ftype\ 1647}# 'core) + (#{fval\ 1776}# + #{e\ 1738}# + #{r\ 1739}# + #{w\ 1740}#)) + (lambda (#{e\ 1792}# + #{r\ 1793}# + #{w\ 1794}# + #{s\ 1795}# + #{mod\ 1796}#) + (#{syntax-type\ 458}# + #{e\ 1792}# + #{r\ 1793}# + #{w\ 1794}# + #{s\ 1795}# + #{rib\ 1742}# + #{mod\ 1796}# + #{for-car?\ 1744}#))) + (if (eqv? #{ftype\ 1775}# 'core) (values 'core-form - #{fval\ 1648}# - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{ftype\ 1647}# 'local-syntax) + #{fval\ 1776}# + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{ftype\ 1775}# 'local-syntax) (values 'local-syntax-form - #{fval\ 1648}# - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{ftype\ 1647}# 'begin) + #{fval\ 1776}# + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{ftype\ 1775}# 'begin) (values 'begin-form #f - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{ftype\ 1647}# 'eval-when) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{ftype\ 1775}# 'eval-when) (values 'eval-when-form #f - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) - (if (eqv? #{ftype\ 1647}# 'define) - (let ((#{tmp\ 1679}# #{e\ 1610}#)) - (let ((#{tmp\ 1680}# + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) + (if (eqv? #{ftype\ 1775}# 'define) + (let ((#{tmp\ 1807}# #{e\ 1738}#)) + (let ((#{tmp\ 1808}# ($sc-dispatch - #{tmp\ 1679}# + #{tmp\ 1807}# '(_ any any)))) - (if (if #{tmp\ 1680}# + (if (if #{tmp\ 1808}# (@apply - (lambda (#{name\ 1683}# - #{val\ 1684}#) - (#{id?\ 379}# - #{name\ 1683}#)) - #{tmp\ 1680}#) + (lambda (#{name\ 1811}# + #{val\ 1812}#) + (#{id?\ 380}# + #{name\ 1811}#)) + #{tmp\ 1808}#) #f) (@apply - (lambda (#{name\ 1687}# - #{val\ 1688}#) + (lambda (#{name\ 1815}# + #{val\ 1816}#) (values 'define-form - #{name\ 1687}# - #{val\ 1688}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#)) - #{tmp\ 1680}#) - (let ((#{tmp\ 1689}# + #{name\ 1815}# + #{val\ 1816}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#)) + #{tmp\ 1808}#) + (let ((#{tmp\ 1817}# ($sc-dispatch - #{tmp\ 1679}# + #{tmp\ 1807}# '(_ (any . any) any . each-any)))) - (if (if #{tmp\ 1689}# + (if (if #{tmp\ 1817}# (@apply - (lambda (#{name\ 1694}# - #{args\ 1695}# - #{e1\ 1696}# - #{e2\ 1697}#) - (if (#{id?\ 379}# - #{name\ 1694}#) - (#{valid-bound-ids?\ 439}# - (#{lambda-var-list\ 491}# - #{args\ 1695}#)) + (lambda (#{name\ 1822}# + #{args\ 1823}# + #{e1\ 1824}# + #{e2\ 1825}#) + (if (#{id?\ 380}# + #{name\ 1822}#) + (#{valid-bound-ids?\ 440}# + (#{lambda-var-list\ 490}# + #{args\ 1823}#)) #f)) - #{tmp\ 1689}#) + #{tmp\ 1817}#) #f) (@apply - (lambda (#{name\ 1704}# - #{args\ 1705}# - #{e1\ 1706}# - #{e2\ 1707}#) + (lambda (#{name\ 1832}# + #{args\ 1833}# + #{e1\ 1834}# + #{e2\ 1835}#) (values 'define-form - (#{wrap\ 445}# - #{name\ 1704}# - #{w\ 1612}# - #{mod\ 1615}#) - (#{decorate-source\ 299}# + (#{wrap\ 446}# + #{name\ 1832}# + #{w\ 1740}# + #{mod\ 1743}#) + (#{decorate-source\ 300}# (cons '#(syntax-object lambda ((top) @@ -3202,10 +3604,10 @@ (top) (top) (top)) - #("i1700" - "i1701" - "i1702" - "i1703")) + #("i1828" + "i1829" + "i1830" + "i1831")) #(ribcage () () @@ -3227,12 +3629,12 @@ (top) (top) (top)) - #("i1653" - "i1654" - "i1655" - "i1656" - "i1657" - "i1658")) + #("i1781" + "i1782" + "i1783" + "i1784" + "i1785" + "i1786")) #(ribcage () () @@ -3240,7 +3642,7 @@ #(ribcage #(first) #((top)) - #("i1645")) + #("i1773")) #(ribcage () () @@ -3268,13 +3670,13 @@ (top) (top) (top)) - #("i1617" - "i1618" - "i1619" - "i1620" - "i1621" - "i1622" - "i1623")) + #("i1745" + "i1746" + "i1747" + "i1748" + "i1749" + "i1750" + "i1751")) #(ribcage (lambda-var-list gen-var @@ -3292,7 +3694,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -3548,60 +3949,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -3610,83 +4010,82 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors @@ -3696,49 +4095,49 @@ (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile)) - (#{wrap\ 445}# - (cons #{args\ 1705}# - (cons #{e1\ 1706}# - #{e2\ 1707}#)) - #{w\ 1612}# - #{mod\ 1615}#)) - #{s\ 1613}#) + (#{wrap\ 446}# + (cons #{args\ 1833}# + (cons #{e1\ 1834}# + #{e2\ 1835}#)) + #{w\ 1740}# + #{mod\ 1743}#)) + #{s\ 1741}#) '(()) - #{s\ 1613}# - #{mod\ 1615}#)) - #{tmp\ 1689}#) - (let ((#{tmp\ 1710}# + #{s\ 1741}# + #{mod\ 1743}#)) + #{tmp\ 1817}#) + (let ((#{tmp\ 1838}# ($sc-dispatch - #{tmp\ 1679}# + #{tmp\ 1807}# '(_ any)))) - (if (if #{tmp\ 1710}# + (if (if #{tmp\ 1838}# (@apply - (lambda (#{name\ 1712}#) - (#{id?\ 379}# - #{name\ 1712}#)) - #{tmp\ 1710}#) + (lambda (#{name\ 1840}#) + (#{id?\ 380}# + #{name\ 1840}#)) + #{tmp\ 1838}#) #f) (@apply - (lambda (#{name\ 1714}#) + (lambda (#{name\ 1842}#) (values 'define-form - (#{wrap\ 445}# - #{name\ 1714}# - #{w\ 1612}# - #{mod\ 1615}#) + (#{wrap\ 446}# + #{name\ 1842}# + #{w\ 1740}# + #{mod\ 1743}#) '(#(syntax-object if ((top) #(ribcage #(name) #((top)) - #("i1713")) + #("i1841")) #(ribcage () () @@ -3760,12 +4159,12 @@ (top) (top) (top)) - #("i1653" - "i1654" - "i1655" - "i1656" - "i1657" - "i1658")) + #("i1781" + "i1782" + "i1783" + "i1784" + "i1785" + "i1786")) #(ribcage () () @@ -3773,7 +4172,7 @@ #(ribcage #(first) #((top)) - #("i1645")) + #("i1773")) #(ribcage () () @@ -3801,13 +4200,13 @@ (top) (top) (top)) - #("i1617" - "i1618" - "i1619" - "i1620" - "i1621" - "i1622" - "i1623")) + #("i1745" + "i1746" + "i1747" + "i1748" + "i1749" + "i1750" + "i1751")) #(ribcage (lambda-var-list gen-var @@ -3825,7 +4224,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -4081,60 +4479,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -4143,83 +4540,82 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors @@ -4229,10 +4625,10 @@ (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile)) #(syntax-object @@ -4241,7 +4637,7 @@ #(ribcage #(name) #((top)) - #("i1713")) + #("i1841")) #(ribcage () () @@ -4263,12 +4659,12 @@ (top) (top) (top)) - #("i1653" - "i1654" - "i1655" - "i1656" - "i1657" - "i1658")) + #("i1781" + "i1782" + "i1783" + "i1784" + "i1785" + "i1786")) #(ribcage () () @@ -4276,7 +4672,7 @@ #(ribcage #(first) #((top)) - #("i1645")) + #("i1773")) #(ribcage () () @@ -4304,13 +4700,13 @@ (top) (top) (top)) - #("i1617" - "i1618" - "i1619" - "i1620" - "i1621" - "i1622" - "i1623")) + #("i1745" + "i1746" + "i1747" + "i1748" + "i1749" + "i1750" + "i1751")) #(ribcage (lambda-var-list gen-var @@ -4328,7 +4724,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -4584,60 +4979,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -4646,83 +5040,82 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors @@ -4732,10 +5125,10 @@ (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile)) #(syntax-object @@ -4744,7 +5137,7 @@ #(ribcage #(name) #((top)) - #("i1713")) + #("i1841")) #(ribcage () () @@ -4766,12 +5159,12 @@ (top) (top) (top)) - #("i1653" - "i1654" - "i1655" - "i1656" - "i1657" - "i1658")) + #("i1781" + "i1782" + "i1783" + "i1784" + "i1785" + "i1786")) #(ribcage () () @@ -4779,7 +5172,7 @@ #(ribcage #(first) #((top)) - #("i1645")) + #("i1773")) #(ribcage () () @@ -4807,13 +5200,13 @@ (top) (top) (top)) - #("i1617" - "i1618" - "i1619" - "i1620" - "i1621" - "i1622" - "i1623")) + #("i1745" + "i1746" + "i1747" + "i1748" + "i1749" + "i1750" + "i1751")) #(ribcage (lambda-var-list gen-var @@ -4831,7 +5224,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -5087,60 +5479,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -5149,83 +5540,82 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors @@ -5235,1207 +5625,860 @@ (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile))) '(()) - #{s\ 1613}# - #{mod\ 1615}#)) - #{tmp\ 1710}#) + #{s\ 1741}# + #{mod\ 1743}#)) + #{tmp\ 1838}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1679}#)))))))) - (if (eqv? #{ftype\ 1647}# + #{tmp\ 1807}#)))))))) + (if (eqv? #{ftype\ 1775}# 'define-syntax) - (let ((#{tmp\ 1717}# #{e\ 1610}#)) - (let ((#{tmp\ 1718}# + (let ((#{tmp\ 1845}# #{e\ 1738}#)) + (let ((#{tmp\ 1846}# ($sc-dispatch - #{tmp\ 1717}# + #{tmp\ 1845}# '(_ any any)))) - (if (if #{tmp\ 1718}# + (if (if #{tmp\ 1846}# (@apply - (lambda (#{name\ 1721}# - #{val\ 1722}#) - (#{id?\ 379}# - #{name\ 1721}#)) - #{tmp\ 1718}#) + (lambda (#{name\ 1849}# + #{val\ 1850}#) + (#{id?\ 380}# + #{name\ 1849}#)) + #{tmp\ 1846}#) #f) (@apply - (lambda (#{name\ 1725}# - #{val\ 1726}#) + (lambda (#{name\ 1853}# + #{val\ 1854}#) (values 'define-syntax-form - #{name\ 1725}# - #{val\ 1726}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#)) - #{tmp\ 1718}#) + #{name\ 1853}# + #{val\ 1854}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#)) + #{tmp\ 1846}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1717}#)))) + #{tmp\ 1845}#)))) (values 'call #f - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#))))))))))))))) - (if (#{syntax-object?\ 345}# #{e\ 1610}#) - (#{syntax-type\ 457}# - (#{syntax-object-expression\ 347}# #{e\ 1610}#) - #{r\ 1611}# - (#{join-wraps\ 427}# - #{w\ 1612}# - (#{syntax-object-wrap\ 349}# #{e\ 1610}#)) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#))))))))))))))) + (if (#{syntax-object?\ 346}# #{e\ 1738}#) + (#{syntax-type\ 458}# + (#{syntax-object-expression\ 348}# #{e\ 1738}#) + #{r\ 1739}# + (#{join-wraps\ 428}# + #{w\ 1740}# + (#{syntax-object-wrap\ 350}# #{e\ 1738}#)) (begin - (let ((#{t\ 1732}# - (#{source-annotation\ 360}# #{e\ 1610}#))) - (if #{t\ 1732}# #{t\ 1732}# #{s\ 1613}#))) - #{rib\ 1614}# + (let ((#{t\ 1860}# + (#{source-annotation\ 361}# #{e\ 1738}#))) + (if #{t\ 1860}# #{t\ 1860}# #{s\ 1741}#))) + #{rib\ 1742}# (begin - (let ((#{t\ 1736}# - (#{syntax-object-module\ 351}# #{e\ 1610}#))) - (if #{t\ 1736}# #{t\ 1736}# #{mod\ 1615}#))) - #{for-car?\ 1616}#) - (if (self-evaluating? #{e\ 1610}#) + (let ((#{t\ 1864}# + (#{syntax-object-module\ 352}# #{e\ 1738}#))) + (if #{t\ 1864}# #{t\ 1864}# #{mod\ 1743}#))) + #{for-car?\ 1744}#) + (if (self-evaluating? #{e\ 1738}#) (values 'constant #f - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#) (values 'other #f - #{e\ 1610}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1615}#))))))) - (#{chi-top\ 459}# - (lambda (#{e\ 1741}# - #{r\ 1742}# - #{w\ 1743}# - #{m\ 1744}# - #{esew\ 1745}# - #{mod\ 1746}#) + #{e\ 1738}# + #{w\ 1740}# + #{s\ 1741}# + #{mod\ 1743}#))))))) + (#{chi\ 460}# + (lambda (#{e\ 1869}# + #{r\ 1870}# + #{w\ 1871}# + #{mod\ 1872}#) (call-with-values (lambda () - (#{syntax-type\ 457}# - #{e\ 1741}# - #{r\ 1742}# - #{w\ 1743}# - (#{source-annotation\ 360}# #{e\ 1741}#) + (#{syntax-type\ 458}# + #{e\ 1869}# + #{r\ 1870}# + #{w\ 1871}# + (#{source-annotation\ 361}# #{e\ 1869}#) #f - #{mod\ 1746}# + #{mod\ 1872}# #f)) - (lambda (#{type\ 1767}# - #{value\ 1768}# - #{e\ 1769}# - #{w\ 1770}# - #{s\ 1771}# - #{mod\ 1772}#) - (if (eqv? #{type\ 1767}# 'begin-form) - (let ((#{tmp\ 1780}# #{e\ 1769}#)) - (let ((#{tmp\ 1781}# ($sc-dispatch #{tmp\ 1780}# '(_)))) - (if #{tmp\ 1781}# - (@apply - (lambda () (#{chi-void\ 475}#)) - #{tmp\ 1781}#) - (let ((#{tmp\ 1782}# - ($sc-dispatch - #{tmp\ 1780}# - '(_ any . each-any)))) - (if #{tmp\ 1782}# - (@apply - (lambda (#{e1\ 1785}# #{e2\ 1786}#) - (#{chi-top-sequence\ 451}# - (cons #{e1\ 1785}# #{e2\ 1786}#) - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - #{m\ 1744}# - #{esew\ 1745}# - #{mod\ 1772}#)) - #{tmp\ 1782}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1780}#)))))) - (if (eqv? #{type\ 1767}# 'local-syntax-form) - (#{chi-local-syntax\ 471}# - #{value\ 1768}# - #{e\ 1769}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - #{mod\ 1772}# - (lambda (#{body\ 1789}# - #{r\ 1790}# - #{w\ 1791}# - #{s\ 1792}# - #{mod\ 1793}#) - (#{chi-top-sequence\ 451}# - #{body\ 1789}# - #{r\ 1790}# - #{w\ 1791}# - #{s\ 1792}# - #{m\ 1744}# - #{esew\ 1745}# - #{mod\ 1793}#))) - (if (eqv? #{type\ 1767}# 'eval-when-form) - (let ((#{tmp\ 1800}# #{e\ 1769}#)) - (let ((#{tmp\ 1801}# - ($sc-dispatch - #{tmp\ 1800}# - '(_ each-any any . each-any)))) - (if #{tmp\ 1801}# - (@apply - (lambda (#{x\ 1805}# #{e1\ 1806}# #{e2\ 1807}#) - (begin - (let ((#{when-list\ 1810}# - (#{chi-when-list\ 455}# - #{e\ 1769}# - #{x\ 1805}# - #{w\ 1770}#)) - (#{body\ 1811}# - (cons #{e1\ 1806}# #{e2\ 1807}#))) - (if (eq? #{m\ 1744}# 'e) - (if (memq 'eval #{when-list\ 1810}#) - (#{chi-top-sequence\ 451}# - #{body\ 1811}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - (if (memq 'expand - #{when-list\ 1810}#) - 'c&e - 'e) - '(eval) - #{mod\ 1772}#) - (begin - (if (memq 'expand - #{when-list\ 1810}#) - (#{top-level-eval-hook\ 290}# - (#{chi-top-sequence\ 451}# - #{body\ 1811}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - 'e - '(eval) - #{mod\ 1772}#) - #{mod\ 1772}#)) - (#{chi-void\ 475}#))) - (if (memq 'load #{when-list\ 1810}#) - (if (begin - (let ((#{t\ 1820}# - (memq 'compile - #{when-list\ 1810}#))) - (if #{t\ 1820}# - #{t\ 1820}# - (begin - (let ((#{t\ 1823}# - (memq 'expand - #{when-list\ 1810}#))) - (if #{t\ 1823}# - #{t\ 1823}# - (if (eq? #{m\ 1744}# - 'c&e) - (memq 'eval - #{when-list\ 1810}#) - #f))))))) - (#{chi-top-sequence\ 451}# - #{body\ 1811}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - 'c&e - '(compile load) - #{mod\ 1772}#) - (if (if (eq? #{m\ 1744}# 'c) - #t - (eq? #{m\ 1744}# 'c&e)) - (#{chi-top-sequence\ 451}# - #{body\ 1811}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - 'c - '(load) - #{mod\ 1772}#) - (#{chi-void\ 475}#))) - (if (begin - (let ((#{t\ 1831}# - (memq 'compile - #{when-list\ 1810}#))) - (if #{t\ 1831}# - #{t\ 1831}# - (begin - (let ((#{t\ 1834}# - (memq 'expand - #{when-list\ 1810}#))) - (if #{t\ 1834}# - #{t\ 1834}# - (if (eq? #{m\ 1744}# - 'c&e) - (memq 'eval - #{when-list\ 1810}#) - #f))))))) - (begin - (#{top-level-eval-hook\ 290}# - (#{chi-top-sequence\ 451}# - #{body\ 1811}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - 'e - '(eval) - #{mod\ 1772}#) - #{mod\ 1772}#) - (#{chi-void\ 475}#)) - (#{chi-void\ 475}#))))))) - #{tmp\ 1801}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1800}#)))) - (if (eqv? #{type\ 1767}# 'define-syntax-form) - (begin - (let ((#{n\ 1842}# - (#{id-var-name\ 433}# - #{value\ 1768}# - #{w\ 1770}#)) - (#{r\ 1843}# - (#{macros-only-env\ 371}# #{r\ 1742}#))) - (if (eqv? #{m\ 1744}# 'c) - (if (memq 'compile #{esew\ 1745}#) - (begin - (let ((#{e\ 1846}# - (#{chi-install-global\ 453}# - #{n\ 1842}# - (#{chi\ 461}# - #{e\ 1769}# - #{r\ 1843}# - #{w\ 1770}# - #{mod\ 1772}#)))) - (begin - (#{top-level-eval-hook\ 290}# - #{e\ 1846}# - #{mod\ 1772}#) - (if (memq 'load #{esew\ 1745}#) - #{e\ 1846}# - (#{chi-void\ 475}#))))) - (if (memq 'load #{esew\ 1745}#) - (#{chi-install-global\ 453}# - #{n\ 1842}# - (#{chi\ 461}# - #{e\ 1769}# - #{r\ 1843}# - #{w\ 1770}# - #{mod\ 1772}#)) - (#{chi-void\ 475}#))) - (if (eqv? #{m\ 1744}# 'c&e) - (begin - (let ((#{e\ 1849}# - (#{chi-install-global\ 453}# - #{n\ 1842}# - (#{chi\ 461}# - #{e\ 1769}# - #{r\ 1843}# - #{w\ 1770}# - #{mod\ 1772}#)))) - (begin - (#{top-level-eval-hook\ 290}# - #{e\ 1849}# - #{mod\ 1772}#) - #{e\ 1849}#))) - (begin - (if (memq 'eval #{esew\ 1745}#) - (#{top-level-eval-hook\ 290}# - (#{chi-install-global\ 453}# - #{n\ 1842}# - (#{chi\ 461}# - #{e\ 1769}# - #{r\ 1843}# - #{w\ 1770}# - #{mod\ 1772}#)) - #{mod\ 1772}#)) - (#{chi-void\ 475}#)))))) - (if (eqv? #{type\ 1767}# 'define-form) - (begin - (let ((#{n\ 1854}# - (#{id-var-name\ 433}# - #{value\ 1768}# - #{w\ 1770}#))) - (begin - (let ((#{type\ 1856}# - (car (#{lookup\ 373}# - #{n\ 1854}# - #{r\ 1742}# - #{mod\ 1772}#)))) - (if (if (eqv? #{type\ 1856}# 'global) - #t - (if (eqv? #{type\ 1856}# 'core) - #t - (if (eqv? #{type\ 1856}# 'macro) - #t - (eqv? #{type\ 1856}# - 'module-ref)))) - (begin - (if (if (if (eq? #{m\ 1744}# 'c) - #t - (eq? #{m\ 1744}# 'c&e)) - (if (not (module-local-variable - (current-module) - #{n\ 1854}#)) - (current-module) - #f) - #f) - (begin - (let ((#{old\ 1863}# - (module-variable - (current-module) - #{n\ 1854}#))) - (if (if (variable? #{old\ 1863}#) - (variable-bound? - #{old\ 1863}#) - #f) - (module-define! - (current-module) - #{n\ 1854}# - (variable-ref #{old\ 1863}#)) - (module-add! - (current-module) - #{n\ 1854}# - (make-undefined-variable)))))) - (begin - (let ((#{x\ 1868}# - (#{build-global-definition\ 321}# - #{s\ 1771}# - #{n\ 1854}# - (#{chi\ 461}# - #{e\ 1769}# - #{r\ 1742}# - #{w\ 1770}# - #{mod\ 1772}#)))) - (begin - (if (eq? #{m\ 1744}# 'c&e) - (#{top-level-eval-hook\ 290}# - #{x\ 1868}# - #{mod\ 1772}#)) - #{x\ 1868}#)))) - (if (eqv? #{type\ 1856}# - 'displaced-lexical) - (syntax-violation - #f - "identifier out of context" - #{e\ 1769}# - (#{wrap\ 445}# - #{value\ 1768}# - #{w\ 1770}# - #{mod\ 1772}#)) - (syntax-violation - #f - "cannot define keyword at top level" - #{e\ 1769}# - (#{wrap\ 445}# - #{value\ 1768}# - #{w\ 1770}# - #{mod\ 1772}#)))))))) - (begin - (let ((#{x\ 1874}# - (#{chi-expr\ 463}# - #{type\ 1767}# - #{value\ 1768}# - #{e\ 1769}# - #{r\ 1742}# - #{w\ 1770}# - #{s\ 1771}# - #{mod\ 1772}#))) - (begin - (if (eq? #{m\ 1744}# 'c&e) - (#{top-level-eval-hook\ 290}# - #{x\ 1874}# - #{mod\ 1772}#)) - #{x\ 1874}#)))))))))))) - (#{chi\ 461}# - (lambda (#{e\ 1875}# - #{r\ 1876}# - #{w\ 1877}# - #{mod\ 1878}#) - (call-with-values - (lambda () - (#{syntax-type\ 457}# - #{e\ 1875}# - #{r\ 1876}# - #{w\ 1877}# - (#{source-annotation\ 360}# #{e\ 1875}#) - #f - #{mod\ 1878}# - #f)) - (lambda (#{type\ 1883}# - #{value\ 1884}# - #{e\ 1885}# - #{w\ 1886}# - #{s\ 1887}# - #{mod\ 1888}#) - (#{chi-expr\ 463}# - #{type\ 1883}# - #{value\ 1884}# - #{e\ 1885}# - #{r\ 1876}# - #{w\ 1886}# - #{s\ 1887}# - #{mod\ 1888}#))))) - (#{chi-expr\ 463}# - (lambda (#{type\ 1895}# - #{value\ 1896}# - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) - (if (eqv? #{type\ 1895}# 'lexical) - (#{build-lexical-reference\ 311}# + (lambda (#{type\ 1877}# + #{value\ 1878}# + #{e\ 1879}# + #{w\ 1880}# + #{s\ 1881}# + #{mod\ 1882}#) + (#{chi-expr\ 462}# + #{type\ 1877}# + #{value\ 1878}# + #{e\ 1879}# + #{r\ 1870}# + #{w\ 1880}# + #{s\ 1881}# + #{mod\ 1882}#))))) + (#{chi-expr\ 462}# + (lambda (#{type\ 1889}# + #{value\ 1890}# + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) + (if (eqv? #{type\ 1889}# 'lexical) + (#{build-lexical-reference\ 312}# 'value - #{s\ 1900}# - #{e\ 1897}# - #{value\ 1896}#) - (if (if (eqv? #{type\ 1895}# 'core) + #{s\ 1894}# + #{e\ 1891}# + #{value\ 1890}#) + (if (if (eqv? #{type\ 1889}# 'core) #t - (eqv? #{type\ 1895}# 'core-form)) - (#{value\ 1896}# - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) - (if (eqv? #{type\ 1895}# 'module-ref) + (eqv? #{type\ 1889}# 'core-form)) + (#{value\ 1890}# + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) + (if (eqv? #{type\ 1889}# 'module-ref) (call-with-values (lambda () - (#{value\ 1896}# - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}#)) - (lambda (#{e\ 1912}# - #{r\ 1913}# - #{w\ 1914}# - #{s\ 1915}# - #{mod\ 1916}#) - (#{chi\ 461}# - #{e\ 1912}# - #{r\ 1913}# - #{w\ 1914}# - #{mod\ 1916}#))) - (if (eqv? #{type\ 1895}# 'lexical-call) - (#{chi-application\ 465}# + (#{value\ 1890}# + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}#)) + (lambda (#{e\ 1906}# + #{r\ 1907}# + #{w\ 1908}# + #{s\ 1909}# + #{mod\ 1910}#) + (#{chi\ 460}# + #{e\ 1906}# + #{r\ 1907}# + #{w\ 1908}# + #{mod\ 1910}#))) + (if (eqv? #{type\ 1889}# 'lexical-call) + (#{chi-application\ 464}# (begin - (let ((#{id\ 1924}# (car #{e\ 1897}#))) - (#{build-lexical-reference\ 311}# + (let ((#{id\ 1918}# (car #{e\ 1891}#))) + (#{build-lexical-reference\ 312}# 'fun - (#{source-annotation\ 360}# #{id\ 1924}#) - (if (#{syntax-object?\ 345}# #{id\ 1924}#) - (syntax->datum #{id\ 1924}#) - #{id\ 1924}#) - #{value\ 1896}#))) - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) - (if (eqv? #{type\ 1895}# 'global-call) - (#{chi-application\ 465}# - (#{build-global-reference\ 317}# - (#{source-annotation\ 360}# (car #{e\ 1897}#)) - (if (#{syntax-object?\ 345}# #{value\ 1896}#) - (#{syntax-object-expression\ 347}# - #{value\ 1896}#) - #{value\ 1896}#) - (if (#{syntax-object?\ 345}# #{value\ 1896}#) - (#{syntax-object-module\ 351}# #{value\ 1896}#) - #{mod\ 1901}#)) - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) - (if (eqv? #{type\ 1895}# 'constant) - (#{build-data\ 331}# - #{s\ 1900}# - (#{strip\ 487}# - (#{source-wrap\ 447}# - #{e\ 1897}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) + (#{source-annotation\ 361}# #{id\ 1918}#) + (if (#{syntax-object?\ 346}# #{id\ 1918}#) + (syntax->datum #{id\ 1918}#) + #{id\ 1918}#) + #{value\ 1890}#))) + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) + (if (eqv? #{type\ 1889}# 'global-call) + (#{chi-application\ 464}# + (#{build-global-reference\ 318}# + (#{source-annotation\ 361}# (car #{e\ 1891}#)) + (if (#{syntax-object?\ 346}# #{value\ 1890}#) + (#{syntax-object-expression\ 348}# + #{value\ 1890}#) + #{value\ 1890}#) + (if (#{syntax-object?\ 346}# #{value\ 1890}#) + (#{syntax-object-module\ 352}# #{value\ 1890}#) + #{mod\ 1895}#)) + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) + (if (eqv? #{type\ 1889}# 'constant) + (#{build-data\ 332}# + #{s\ 1894}# + (#{strip\ 486}# + (#{source-wrap\ 448}# + #{e\ 1891}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) '(()))) - (if (eqv? #{type\ 1895}# 'global) - (#{build-global-reference\ 317}# - #{s\ 1900}# - #{value\ 1896}# - #{mod\ 1901}#) - (if (eqv? #{type\ 1895}# 'call) - (#{chi-application\ 465}# - (#{chi\ 461}# - (car #{e\ 1897}#) - #{r\ 1898}# - #{w\ 1899}# - #{mod\ 1901}#) - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) - (if (eqv? #{type\ 1895}# 'begin-form) - (let ((#{tmp\ 1931}# #{e\ 1897}#)) - (let ((#{tmp\ 1932}# + (if (eqv? #{type\ 1889}# 'global) + (#{build-global-reference\ 318}# + #{s\ 1894}# + #{value\ 1890}# + #{mod\ 1895}#) + (if (eqv? #{type\ 1889}# 'call) + (#{chi-application\ 464}# + (#{chi\ 460}# + (car #{e\ 1891}#) + #{r\ 1892}# + #{w\ 1893}# + #{mod\ 1895}#) + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) + (if (eqv? #{type\ 1889}# 'begin-form) + (let ((#{tmp\ 1925}# #{e\ 1891}#)) + (let ((#{tmp\ 1926}# ($sc-dispatch - #{tmp\ 1931}# + #{tmp\ 1925}# '(_ any . each-any)))) - (if #{tmp\ 1932}# + (if #{tmp\ 1926}# (@apply - (lambda (#{e1\ 1935}# #{e2\ 1936}#) - (#{chi-sequence\ 449}# - (cons #{e1\ 1935}# #{e2\ 1936}#) - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#)) - #{tmp\ 1932}#) + (lambda (#{e1\ 1929}# #{e2\ 1930}#) + (#{chi-sequence\ 450}# + (cons #{e1\ 1929}# #{e2\ 1930}#) + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#)) + #{tmp\ 1926}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1931}#)))) - (if (eqv? #{type\ 1895}# 'local-syntax-form) - (#{chi-local-syntax\ 471}# - #{value\ 1896}# - #{e\ 1897}# - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}# - #{chi-sequence\ 449}#) - (if (eqv? #{type\ 1895}# 'eval-when-form) - (let ((#{tmp\ 1940}# #{e\ 1897}#)) - (let ((#{tmp\ 1941}# + #{tmp\ 1925}#)))) + (if (eqv? #{type\ 1889}# 'local-syntax-form) + (#{chi-local-syntax\ 470}# + #{value\ 1890}# + #{e\ 1891}# + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}# + #{chi-sequence\ 450}#) + (if (eqv? #{type\ 1889}# 'eval-when-form) + (let ((#{tmp\ 1934}# #{e\ 1891}#)) + (let ((#{tmp\ 1935}# ($sc-dispatch - #{tmp\ 1940}# + #{tmp\ 1934}# '(_ each-any any . each-any)))) - (if #{tmp\ 1941}# + (if #{tmp\ 1935}# (@apply - (lambda (#{x\ 1945}# - #{e1\ 1946}# - #{e2\ 1947}#) + (lambda (#{x\ 1939}# + #{e1\ 1940}# + #{e2\ 1941}#) (begin - (let ((#{when-list\ 1949}# - (#{chi-when-list\ 455}# - #{e\ 1897}# - #{x\ 1945}# - #{w\ 1899}#))) + (let ((#{when-list\ 1943}# + (#{chi-when-list\ 456}# + #{e\ 1891}# + #{x\ 1939}# + #{w\ 1893}#))) (if (memq 'eval - #{when-list\ 1949}#) - (#{chi-sequence\ 449}# - (cons #{e1\ 1946}# - #{e2\ 1947}#) - #{r\ 1898}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#) - (#{chi-void\ 475}#))))) - #{tmp\ 1941}#) + #{when-list\ 1943}#) + (#{chi-sequence\ 450}# + (cons #{e1\ 1940}# + #{e2\ 1941}#) + #{r\ 1892}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#) + (#{chi-void\ 474}#))))) + #{tmp\ 1935}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1940}#)))) - (if (if (eqv? #{type\ 1895}# 'define-form) + #{tmp\ 1934}#)))) + (if (if (eqv? #{type\ 1889}# 'define-form) #t - (eqv? #{type\ 1895}# + (eqv? #{type\ 1889}# 'define-syntax-form)) (syntax-violation #f "definition in expression context" - #{e\ 1897}# - (#{wrap\ 445}# - #{value\ 1896}# - #{w\ 1899}# - #{mod\ 1901}#)) - (if (eqv? #{type\ 1895}# 'syntax) + #{e\ 1891}# + (#{wrap\ 446}# + #{value\ 1890}# + #{w\ 1893}# + #{mod\ 1895}#)) + (if (eqv? #{type\ 1889}# 'syntax) (syntax-violation #f "reference to pattern variable outside syntax form" - (#{source-wrap\ 447}# - #{e\ 1897}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#)) - (if (eqv? #{type\ 1895}# + (#{source-wrap\ 448}# + #{e\ 1891}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#)) + (if (eqv? #{type\ 1889}# 'displaced-lexical) (syntax-violation #f "reference to identifier outside its scope" - (#{source-wrap\ 447}# - #{e\ 1897}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#)) + (#{source-wrap\ 448}# + #{e\ 1891}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#)) (syntax-violation #f "unexpected syntax" - (#{source-wrap\ 447}# - #{e\ 1897}# - #{w\ 1899}# - #{s\ 1900}# - #{mod\ 1901}#)))))))))))))))))) - (#{chi-application\ 465}# - (lambda (#{x\ 1956}# - #{e\ 1957}# - #{r\ 1958}# - #{w\ 1959}# - #{s\ 1960}# - #{mod\ 1961}#) - (let ((#{tmp\ 1968}# #{e\ 1957}#)) - (let ((#{tmp\ 1969}# - ($sc-dispatch #{tmp\ 1968}# '(any . each-any)))) - (if #{tmp\ 1969}# + (#{source-wrap\ 448}# + #{e\ 1891}# + #{w\ 1893}# + #{s\ 1894}# + #{mod\ 1895}#)))))))))))))))))) + (#{chi-application\ 464}# + (lambda (#{x\ 1950}# + #{e\ 1951}# + #{r\ 1952}# + #{w\ 1953}# + #{s\ 1954}# + #{mod\ 1955}#) + (let ((#{tmp\ 1962}# #{e\ 1951}#)) + (let ((#{tmp\ 1963}# + ($sc-dispatch #{tmp\ 1962}# '(any . each-any)))) + (if #{tmp\ 1963}# (@apply - (lambda (#{e0\ 1972}# #{e1\ 1973}#) - (#{build-application\ 305}# - #{s\ 1960}# - #{x\ 1956}# - (map (lambda (#{e\ 1974}#) - (#{chi\ 461}# - #{e\ 1974}# - #{r\ 1958}# - #{w\ 1959}# - #{mod\ 1961}#)) - #{e1\ 1973}#))) - #{tmp\ 1969}#) + (lambda (#{e0\ 1966}# #{e1\ 1967}#) + (#{build-application\ 306}# + #{s\ 1954}# + #{x\ 1950}# + (map (lambda (#{e\ 1968}#) + (#{chi\ 460}# + #{e\ 1968}# + #{r\ 1952}# + #{w\ 1953}# + #{mod\ 1955}#)) + #{e1\ 1967}#))) + #{tmp\ 1963}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1968}#)))))) - (#{chi-macro\ 467}# - (lambda (#{p\ 1977}# - #{e\ 1978}# - #{r\ 1979}# - #{w\ 1980}# - #{s\ 1981}# - #{rib\ 1982}# - #{mod\ 1983}#) + #{tmp\ 1962}#)))))) + (#{chi-macro\ 466}# + (lambda (#{p\ 1971}# + #{e\ 1972}# + #{r\ 1973}# + #{w\ 1974}# + #{s\ 1975}# + #{rib\ 1976}# + #{mod\ 1977}#) (letrec* - ((#{rebuild-macro-output\ 1992}# - (lambda (#{x\ 1993}# #{m\ 1994}#) - (if (pair? #{x\ 1993}#) - (#{decorate-source\ 299}# - (cons (#{rebuild-macro-output\ 1992}# - (car #{x\ 1993}#) - #{m\ 1994}#) - (#{rebuild-macro-output\ 1992}# - (cdr #{x\ 1993}#) - #{m\ 1994}#)) - #{s\ 1981}#) - (if (#{syntax-object?\ 345}# #{x\ 1993}#) + ((#{rebuild-macro-output\ 1986}# + (lambda (#{x\ 1987}# #{m\ 1988}#) + (if (pair? #{x\ 1987}#) + (#{decorate-source\ 300}# + (cons (#{rebuild-macro-output\ 1986}# + (car #{x\ 1987}#) + #{m\ 1988}#) + (#{rebuild-macro-output\ 1986}# + (cdr #{x\ 1987}#) + #{m\ 1988}#)) + #{s\ 1975}#) + (if (#{syntax-object?\ 346}# #{x\ 1987}#) (begin - (let ((#{w\ 2002}# - (#{syntax-object-wrap\ 349}# #{x\ 1993}#))) + (let ((#{w\ 1996}# + (#{syntax-object-wrap\ 350}# #{x\ 1987}#))) (begin - (let ((#{ms\ 2005}# (car #{w\ 2002}#)) - (#{s\ 2006}# (cdr #{w\ 2002}#))) - (if (if (pair? #{ms\ 2005}#) - (eq? (car #{ms\ 2005}#) #f) + (let ((#{ms\ 1999}# (car #{w\ 1996}#)) + (#{s\ 2000}# (cdr #{w\ 1996}#))) + (if (if (pair? #{ms\ 1999}#) + (eq? (car #{ms\ 1999}#) #f) #f) - (#{make-syntax-object\ 343}# - (#{syntax-object-expression\ 347}# - #{x\ 1993}#) - (cons (cdr #{ms\ 2005}#) - (if #{rib\ 1982}# - (cons #{rib\ 1982}# - (cdr #{s\ 2006}#)) - (cdr #{s\ 2006}#))) - (#{syntax-object-module\ 351}# - #{x\ 1993}#)) - (#{make-syntax-object\ 343}# - (#{decorate-source\ 299}# - (#{syntax-object-expression\ 347}# - #{x\ 1993}#) - #{s\ 2006}#) - (cons (cons #{m\ 1994}# #{ms\ 2005}#) - (if #{rib\ 1982}# - (cons #{rib\ 1982}# - (cons 'shift #{s\ 2006}#)) - (cons 'shift #{s\ 2006}#))) - (#{syntax-object-module\ 351}# - #{x\ 1993}#))))))) - (if (vector? #{x\ 1993}#) + (#{make-syntax-object\ 344}# + (#{syntax-object-expression\ 348}# + #{x\ 1987}#) + (cons (cdr #{ms\ 1999}#) + (if #{rib\ 1976}# + (cons #{rib\ 1976}# + (cdr #{s\ 2000}#)) + (cdr #{s\ 2000}#))) + (#{syntax-object-module\ 352}# + #{x\ 1987}#)) + (#{make-syntax-object\ 344}# + (#{decorate-source\ 300}# + (#{syntax-object-expression\ 348}# + #{x\ 1987}#) + #{s\ 2000}#) + (cons (cons #{m\ 1988}# #{ms\ 1999}#) + (if #{rib\ 1976}# + (cons #{rib\ 1976}# + (cons 'shift #{s\ 2000}#)) + (cons 'shift #{s\ 2000}#))) + (#{syntax-object-module\ 352}# + #{x\ 1987}#))))))) + (if (vector? #{x\ 1987}#) (begin - (let ((#{n\ 2018}# (vector-length #{x\ 1993}#))) + (let ((#{n\ 2012}# (vector-length #{x\ 1987}#))) (begin - (let ((#{v\ 2020}# - (#{decorate-source\ 299}# - (make-vector #{n\ 2018}#) - #{x\ 1993}#))) + (let ((#{v\ 2014}# + (#{decorate-source\ 300}# + (make-vector #{n\ 2012}#) + #{x\ 1987}#))) (letrec* - ((#{loop\ 2023}# - (lambda (#{i\ 2024}#) - (if (#{fx=\ 286}# - #{i\ 2024}# - #{n\ 2018}#) - (begin (if #f #f) #{v\ 2020}#) + ((#{loop\ 2017}# + (lambda (#{i\ 2018}#) + (if (#{fx=\ 287}# + #{i\ 2018}# + #{n\ 2012}#) + (begin (if #f #f) #{v\ 2014}#) (begin (vector-set! - #{v\ 2020}# - #{i\ 2024}# - (#{rebuild-macro-output\ 1992}# + #{v\ 2014}# + #{i\ 2018}# + (#{rebuild-macro-output\ 1986}# (vector-ref - #{x\ 1993}# - #{i\ 2024}#) - #{m\ 1994}#)) - (#{loop\ 2023}# - (#{fx+\ 282}# - #{i\ 2024}# + #{x\ 1987}# + #{i\ 2018}#) + #{m\ 1988}#)) + (#{loop\ 2017}# + (#{fx+\ 283}# + #{i\ 2018}# 1))))))) - (begin (#{loop\ 2023}# 0))))))) - (if (symbol? #{x\ 1993}#) + (begin (#{loop\ 2017}# 0))))))) + (if (symbol? #{x\ 1987}#) (syntax-violation #f "encountered raw symbol in macro output" - (#{source-wrap\ 447}# - #{e\ 1978}# - #{w\ 1980}# - (cdr #{w\ 1980}#) - #{mod\ 1983}#) - #{x\ 1993}#) - (#{decorate-source\ 299}# - #{x\ 1993}# - #{s\ 1981}#)))))))) + (#{source-wrap\ 448}# + #{e\ 1972}# + #{w\ 1974}# + (cdr #{w\ 1974}#) + #{mod\ 1977}#) + #{x\ 1987}#) + (#{decorate-source\ 300}# + #{x\ 1987}# + #{s\ 1975}#)))))))) (begin - (#{rebuild-macro-output\ 1992}# - (#{p\ 1977}# - (#{source-wrap\ 447}# - #{e\ 1978}# - (#{anti-mark\ 417}# #{w\ 1980}#) - #{s\ 1981}# - #{mod\ 1983}#)) + (#{rebuild-macro-output\ 1986}# + (#{p\ 1971}# + (#{source-wrap\ 448}# + #{e\ 1972}# + (#{anti-mark\ 418}# #{w\ 1974}#) + #{s\ 1975}# + #{mod\ 1977}#)) (gensym "m")))))) - (#{chi-body\ 469}# - (lambda (#{body\ 2032}# - #{outer-form\ 2033}# - #{r\ 2034}# - #{w\ 2035}# - #{mod\ 2036}#) + (#{chi-body\ 468}# + (lambda (#{body\ 2026}# + #{outer-form\ 2027}# + #{r\ 2028}# + #{w\ 2029}# + #{mod\ 2030}#) (begin - (let ((#{r\ 2044}# - (cons '("placeholder" placeholder) #{r\ 2034}#))) + (let ((#{r\ 2038}# + (cons '("placeholder" placeholder) #{r\ 2028}#))) (begin - (let ((#{ribcage\ 2046}# - (#{make-ribcage\ 397}# '() '() '()))) + (let ((#{ribcage\ 2040}# + (#{make-ribcage\ 398}# '() '() '()))) (begin - (let ((#{w\ 2049}# - (cons (car #{w\ 2035}#) - (cons #{ribcage\ 2046}# - (cdr #{w\ 2035}#))))) + (let ((#{w\ 2043}# + (cons (car #{w\ 2029}#) + (cons #{ribcage\ 2040}# + (cdr #{w\ 2029}#))))) (letrec* - ((#{parse\ 2061}# - (lambda (#{body\ 2062}# - #{ids\ 2063}# - #{labels\ 2064}# - #{var-ids\ 2065}# - #{vars\ 2066}# - #{vals\ 2067}# - #{bindings\ 2068}#) - (if (null? #{body\ 2062}#) + ((#{parse\ 2055}# + (lambda (#{body\ 2056}# + #{ids\ 2057}# + #{labels\ 2058}# + #{var-ids\ 2059}# + #{vars\ 2060}# + #{vals\ 2061}# + #{bindings\ 2062}#) + (if (null? #{body\ 2056}#) (syntax-violation #f "no expressions in body" - #{outer-form\ 2033}#) + #{outer-form\ 2027}#) (begin - (let ((#{e\ 2073}# - (cdr (car #{body\ 2062}#))) - (#{er\ 2074}# - (car (car #{body\ 2062}#)))) + (let ((#{e\ 2067}# + (cdr (car #{body\ 2056}#))) + (#{er\ 2068}# + (car (car #{body\ 2056}#)))) (call-with-values (lambda () - (#{syntax-type\ 457}# - #{e\ 2073}# - #{er\ 2074}# + (#{syntax-type\ 458}# + #{e\ 2067}# + #{er\ 2068}# '(()) - (#{source-annotation\ 360}# - #{er\ 2074}#) - #{ribcage\ 2046}# - #{mod\ 2036}# + (#{source-annotation\ 361}# + #{er\ 2068}#) + #{ribcage\ 2040}# + #{mod\ 2030}# #f)) - (lambda (#{type\ 2076}# - #{value\ 2077}# - #{e\ 2078}# - #{w\ 2079}# - #{s\ 2080}# - #{mod\ 2081}#) - (if (eqv? #{type\ 2076}# + (lambda (#{type\ 2070}# + #{value\ 2071}# + #{e\ 2072}# + #{w\ 2073}# + #{s\ 2074}# + #{mod\ 2075}#) + (if (eqv? #{type\ 2070}# 'define-form) (begin - (let ((#{id\ 2091}# - (#{wrap\ 445}# - #{value\ 2077}# - #{w\ 2079}# - #{mod\ 2081}#)) - (#{label\ 2092}# - (#{gen-label\ 392}#))) + (let ((#{id\ 2085}# + (#{wrap\ 446}# + #{value\ 2071}# + #{w\ 2073}# + #{mod\ 2075}#)) + (#{label\ 2086}# + (#{gen-label\ 393}#))) (begin - (let ((#{var\ 2094}# - (#{gen-var\ 489}# - #{id\ 2091}#))) + (let ((#{var\ 2088}# + (#{gen-var\ 488}# + #{id\ 2085}#))) (begin - (#{extend-ribcage!\ 421}# - #{ribcage\ 2046}# - #{id\ 2091}# - #{label\ 2092}#) - (#{parse\ 2061}# - (cdr #{body\ 2062}#) - (cons #{id\ 2091}# - #{ids\ 2063}#) - (cons #{label\ 2092}# - #{labels\ 2064}#) - (cons #{id\ 2091}# - #{var-ids\ 2065}#) - (cons #{var\ 2094}# - #{vars\ 2066}#) - (cons (cons #{er\ 2074}# - (#{wrap\ 445}# - #{e\ 2078}# - #{w\ 2079}# - #{mod\ 2081}#)) - #{vals\ 2067}#) + (#{extend-ribcage!\ 422}# + #{ribcage\ 2040}# + #{id\ 2085}# + #{label\ 2086}#) + (#{parse\ 2055}# + (cdr #{body\ 2056}#) + (cons #{id\ 2085}# + #{ids\ 2057}#) + (cons #{label\ 2086}# + #{labels\ 2058}#) + (cons #{id\ 2085}# + #{var-ids\ 2059}#) + (cons #{var\ 2088}# + #{vars\ 2060}#) + (cons (cons #{er\ 2068}# + (#{wrap\ 446}# + #{e\ 2072}# + #{w\ 2073}# + #{mod\ 2075}#)) + #{vals\ 2061}#) (cons (cons 'lexical - #{var\ 2094}#) - #{bindings\ 2068}#))))))) - (if (eqv? #{type\ 2076}# + #{var\ 2088}#) + #{bindings\ 2062}#))))))) + (if (eqv? #{type\ 2070}# 'define-syntax-form) (begin - (let ((#{id\ 2099}# - (#{wrap\ 445}# - #{value\ 2077}# - #{w\ 2079}# - #{mod\ 2081}#)) - (#{label\ 2100}# - (#{gen-label\ 392}#))) + (let ((#{id\ 2093}# + (#{wrap\ 446}# + #{value\ 2071}# + #{w\ 2073}# + #{mod\ 2075}#)) + (#{label\ 2094}# + (#{gen-label\ 393}#))) (begin - (#{extend-ribcage!\ 421}# - #{ribcage\ 2046}# - #{id\ 2099}# - #{label\ 2100}#) - (#{parse\ 2061}# - (cdr #{body\ 2062}#) - (cons #{id\ 2099}# - #{ids\ 2063}#) - (cons #{label\ 2100}# - #{labels\ 2064}#) - #{var-ids\ 2065}# - #{vars\ 2066}# - #{vals\ 2067}# + (#{extend-ribcage!\ 422}# + #{ribcage\ 2040}# + #{id\ 2093}# + #{label\ 2094}#) + (#{parse\ 2055}# + (cdr #{body\ 2056}#) + (cons #{id\ 2093}# + #{ids\ 2057}#) + (cons #{label\ 2094}# + #{labels\ 2058}#) + #{var-ids\ 2059}# + #{vars\ 2060}# + #{vals\ 2061}# (cons (cons 'macro - (cons #{er\ 2074}# - (#{wrap\ 445}# - #{e\ 2078}# - #{w\ 2079}# - #{mod\ 2081}#))) - #{bindings\ 2068}#))))) - (if (eqv? #{type\ 2076}# + (cons #{er\ 2068}# + (#{wrap\ 446}# + #{e\ 2072}# + #{w\ 2073}# + #{mod\ 2075}#))) + #{bindings\ 2062}#))))) + (if (eqv? #{type\ 2070}# 'begin-form) - (let ((#{tmp\ 2103}# - #{e\ 2078}#)) - (let ((#{tmp\ 2104}# + (let ((#{tmp\ 2097}# + #{e\ 2072}#)) + (let ((#{tmp\ 2098}# ($sc-dispatch - #{tmp\ 2103}# + #{tmp\ 2097}# '(_ . each-any)))) - (if #{tmp\ 2104}# + (if #{tmp\ 2098}# (@apply - (lambda (#{e1\ 2106}#) - (#{parse\ 2061}# + (lambda (#{e1\ 2100}#) + (#{parse\ 2055}# (letrec* - ((#{f\ 2109}# - (lambda (#{forms\ 2110}#) - (if (null? #{forms\ 2110}#) - (cdr #{body\ 2062}#) - (cons (cons #{er\ 2074}# - (#{wrap\ 445}# - (car #{forms\ 2110}#) - #{w\ 2079}# - #{mod\ 2081}#)) - (#{f\ 2109}# - (cdr #{forms\ 2110}#))))))) + ((#{f\ 2103}# + (lambda (#{forms\ 2104}#) + (if (null? #{forms\ 2104}#) + (cdr #{body\ 2056}#) + (cons (cons #{er\ 2068}# + (#{wrap\ 446}# + (car #{forms\ 2104}#) + #{w\ 2073}# + #{mod\ 2075}#)) + (#{f\ 2103}# + (cdr #{forms\ 2104}#))))))) (begin - (#{f\ 2109}# - #{e1\ 2106}#))) - #{ids\ 2063}# - #{labels\ 2064}# - #{var-ids\ 2065}# - #{vars\ 2066}# - #{vals\ 2067}# - #{bindings\ 2068}#)) - #{tmp\ 2104}#) + (#{f\ 2103}# + #{e1\ 2100}#))) + #{ids\ 2057}# + #{labels\ 2058}# + #{var-ids\ 2059}# + #{vars\ 2060}# + #{vals\ 2061}# + #{bindings\ 2062}#)) + #{tmp\ 2098}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2103}#)))) - (if (eqv? #{type\ 2076}# + #{tmp\ 2097}#)))) + (if (eqv? #{type\ 2070}# 'local-syntax-form) - (#{chi-local-syntax\ 471}# - #{value\ 2077}# - #{e\ 2078}# - #{er\ 2074}# - #{w\ 2079}# - #{s\ 2080}# - #{mod\ 2081}# - (lambda (#{forms\ 2113}# - #{er\ 2114}# - #{w\ 2115}# - #{s\ 2116}# - #{mod\ 2117}#) - (#{parse\ 2061}# + (#{chi-local-syntax\ 470}# + #{value\ 2071}# + #{e\ 2072}# + #{er\ 2068}# + #{w\ 2073}# + #{s\ 2074}# + #{mod\ 2075}# + (lambda (#{forms\ 2107}# + #{er\ 2108}# + #{w\ 2109}# + #{s\ 2110}# + #{mod\ 2111}#) + (#{parse\ 2055}# (letrec* - ((#{f\ 2125}# - (lambda (#{forms\ 2126}#) - (if (null? #{forms\ 2126}#) - (cdr #{body\ 2062}#) - (cons (cons #{er\ 2114}# - (#{wrap\ 445}# - (car #{forms\ 2126}#) - #{w\ 2115}# - #{mod\ 2117}#)) - (#{f\ 2125}# - (cdr #{forms\ 2126}#))))))) + ((#{f\ 2119}# + (lambda (#{forms\ 2120}#) + (if (null? #{forms\ 2120}#) + (cdr #{body\ 2056}#) + (cons (cons #{er\ 2108}# + (#{wrap\ 446}# + (car #{forms\ 2120}#) + #{w\ 2109}# + #{mod\ 2111}#)) + (#{f\ 2119}# + (cdr #{forms\ 2120}#))))))) (begin - (#{f\ 2125}# - #{forms\ 2113}#))) - #{ids\ 2063}# - #{labels\ 2064}# - #{var-ids\ 2065}# - #{vars\ 2066}# - #{vals\ 2067}# - #{bindings\ 2068}#))) - (if (null? #{ids\ 2063}#) - (#{build-sequence\ 333}# + (#{f\ 2119}# + #{forms\ 2107}#))) + #{ids\ 2057}# + #{labels\ 2058}# + #{var-ids\ 2059}# + #{vars\ 2060}# + #{vals\ 2061}# + #{bindings\ 2062}#))) + (if (null? #{ids\ 2057}#) + (#{build-sequence\ 334}# #f - (map (lambda (#{x\ 2129}#) - (#{chi\ 461}# - (cdr #{x\ 2129}#) - (car #{x\ 2129}#) + (map (lambda (#{x\ 2123}#) + (#{chi\ 460}# + (cdr #{x\ 2123}#) + (car #{x\ 2123}#) '(()) - #{mod\ 2081}#)) - (cons (cons #{er\ 2074}# - (#{source-wrap\ 447}# - #{e\ 2078}# - #{w\ 2079}# - #{s\ 2080}# - #{mod\ 2081}#)) - (cdr #{body\ 2062}#)))) + #{mod\ 2075}#)) + (cons (cons #{er\ 2068}# + (#{source-wrap\ 448}# + #{e\ 2072}# + #{w\ 2073}# + #{s\ 2074}# + #{mod\ 2075}#)) + (cdr #{body\ 2056}#)))) (begin - (if (not (#{valid-bound-ids?\ 439}# - #{ids\ 2063}#)) + (if (not (#{valid-bound-ids?\ 440}# + #{ids\ 2057}#)) (syntax-violation #f "invalid or duplicate identifier in definition" - #{outer-form\ 2033}#)) + #{outer-form\ 2027}#)) (letrec* - ((#{loop\ 2136}# - (lambda (#{bs\ 2137}# - #{er-cache\ 2138}# - #{r-cache\ 2139}#) - (if (not (null? #{bs\ 2137}#)) + ((#{loop\ 2130}# + (lambda (#{bs\ 2131}# + #{er-cache\ 2132}# + #{r-cache\ 2133}#) + (if (not (null? #{bs\ 2131}#)) (begin - (let ((#{b\ 2142}# - (car #{bs\ 2137}#))) - (if (eq? (car #{b\ 2142}#) + (let ((#{b\ 2136}# + (car #{bs\ 2131}#))) + (if (eq? (car #{b\ 2136}#) 'macro) (begin - (let ((#{er\ 2145}# - (car (cdr #{b\ 2142}#)))) + (let ((#{er\ 2139}# + (car (cdr #{b\ 2136}#)))) (begin - (let ((#{r-cache\ 2147}# - (if (eq? #{er\ 2145}# - #{er-cache\ 2138}#) - #{r-cache\ 2139}# - (#{macros-only-env\ 371}# - #{er\ 2145}#)))) + (let ((#{r-cache\ 2141}# + (if (eq? #{er\ 2139}# + #{er-cache\ 2132}#) + #{r-cache\ 2133}# + (#{macros-only-env\ 372}# + #{er\ 2139}#)))) (begin (set-cdr! - #{b\ 2142}# - (#{eval-local-transformer\ 473}# - (#{chi\ 461}# - (cdr (cdr #{b\ 2142}#)) - #{r-cache\ 2147}# + #{b\ 2136}# + (#{eval-local-transformer\ 472}# + (#{chi\ 460}# + (cdr (cdr #{b\ 2136}#)) + #{r-cache\ 2141}# '(()) - #{mod\ 2081}#) - #{mod\ 2081}#)) - (#{loop\ 2136}# - (cdr #{bs\ 2137}#) - #{er\ 2145}# - #{r-cache\ 2147}#)))))) - (#{loop\ 2136}# - (cdr #{bs\ 2137}#) - #{er-cache\ 2138}# - #{r-cache\ 2139}#)))))))) + #{mod\ 2075}#) + #{mod\ 2075}#)) + (#{loop\ 2130}# + (cdr #{bs\ 2131}#) + #{er\ 2139}# + #{r-cache\ 2141}#)))))) + (#{loop\ 2130}# + (cdr #{bs\ 2131}#) + #{er-cache\ 2132}# + #{r-cache\ 2133}#)))))))) (begin - (#{loop\ 2136}# - #{bindings\ 2068}# + (#{loop\ 2130}# + #{bindings\ 2062}# #f #f))) (set-cdr! - #{r\ 2044}# - (#{extend-env\ 367}# - #{labels\ 2064}# - #{bindings\ 2068}# - (cdr #{r\ 2044}#))) - (#{build-letrec\ 339}# + #{r\ 2038}# + (#{extend-env\ 368}# + #{labels\ 2058}# + #{bindings\ 2062}# + (cdr #{r\ 2038}#))) + (#{build-letrec\ 340}# #f #t (reverse (map syntax->datum - #{var-ids\ 2065}#)) + #{var-ids\ 2059}#)) (reverse - #{vars\ 2066}#) - (map (lambda (#{x\ 2150}#) - (#{chi\ 461}# - (cdr #{x\ 2150}#) - (car #{x\ 2150}#) + #{vars\ 2060}#) + (map (lambda (#{x\ 2144}#) + (#{chi\ 460}# + (cdr #{x\ 2144}#) + (car #{x\ 2144}#) '(()) - #{mod\ 2081}#)) + #{mod\ 2075}#)) (reverse - #{vals\ 2067}#)) - (#{build-sequence\ 333}# + #{vals\ 2061}#)) + (#{build-sequence\ 334}# #f - (map (lambda (#{x\ 2154}#) - (#{chi\ 461}# - (cdr #{x\ 2154}#) - (car #{x\ 2154}#) + (map (lambda (#{x\ 2148}#) + (#{chi\ 460}# + (cdr #{x\ 2148}#) + (car #{x\ 2148}#) '(()) - #{mod\ 2081}#)) - (cons (cons #{er\ 2074}# - (#{source-wrap\ 447}# - #{e\ 2078}# - #{w\ 2079}# - #{s\ 2080}# - #{mod\ 2081}#)) - (cdr #{body\ 2062}#))))))))))))))))))) + #{mod\ 2075}#)) + (cons (cons #{er\ 2068}# + (#{source-wrap\ 448}# + #{e\ 2072}# + #{w\ 2073}# + #{s\ 2074}# + #{mod\ 2075}#)) + (cdr #{body\ 2056}#))))))))))))))))))) (begin - (#{parse\ 2061}# - (map (lambda (#{x\ 2069}#) - (cons #{r\ 2044}# - (#{wrap\ 445}# - #{x\ 2069}# - #{w\ 2049}# - #{mod\ 2036}#))) - #{body\ 2032}#) + (#{parse\ 2055}# + (map (lambda (#{x\ 2063}#) + (cons #{r\ 2038}# + (#{wrap\ 446}# + #{x\ 2063}# + #{w\ 2043}# + #{mod\ 2030}#))) + #{body\ 2026}#) '() '() '() '() '() '()))))))))))) - (#{chi-local-syntax\ 471}# - (lambda (#{rec?\ 2157}# - #{e\ 2158}# - #{r\ 2159}# - #{w\ 2160}# - #{s\ 2161}# - #{mod\ 2162}# - #{k\ 2163}#) - (let ((#{tmp\ 2171}# #{e\ 2158}#)) - (let ((#{tmp\ 2172}# + (#{chi-local-syntax\ 470}# + (lambda (#{rec?\ 2151}# + #{e\ 2152}# + #{r\ 2153}# + #{w\ 2154}# + #{s\ 2155}# + #{mod\ 2156}# + #{k\ 2157}#) + (let ((#{tmp\ 2165}# #{e\ 2152}#)) + (let ((#{tmp\ 2166}# ($sc-dispatch - #{tmp\ 2171}# + #{tmp\ 2165}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 2172}# + (if #{tmp\ 2166}# (@apply - (lambda (#{id\ 2177}# - #{val\ 2178}# - #{e1\ 2179}# - #{e2\ 2180}#) + (lambda (#{id\ 2171}# + #{val\ 2172}# + #{e1\ 2173}# + #{e2\ 2174}#) (begin - (let ((#{ids\ 2182}# #{id\ 2177}#)) - (if (not (#{valid-bound-ids?\ 439}# #{ids\ 2182}#)) + (let ((#{ids\ 2176}# #{id\ 2171}#)) + (if (not (#{valid-bound-ids?\ 440}# #{ids\ 2176}#)) (syntax-violation #f "duplicate bound keyword" - #{e\ 2158}#) + #{e\ 2152}#) (begin - (let ((#{labels\ 2185}# - (#{gen-labels\ 394}# #{ids\ 2182}#))) + (let ((#{labels\ 2179}# + (#{gen-labels\ 395}# #{ids\ 2176}#))) (begin - (let ((#{new-w\ 2187}# - (#{make-binding-wrap\ 423}# - #{ids\ 2182}# - #{labels\ 2185}# - #{w\ 2160}#))) - (#{k\ 2163}# - (cons #{e1\ 2179}# #{e2\ 2180}#) - (#{extend-env\ 367}# - #{labels\ 2185}# + (let ((#{new-w\ 2181}# + (#{make-binding-wrap\ 424}# + #{ids\ 2176}# + #{labels\ 2179}# + #{w\ 2154}#))) + (#{k\ 2157}# + (cons #{e1\ 2173}# #{e2\ 2174}#) + (#{extend-env\ 368}# + #{labels\ 2179}# (begin - (let ((#{w\ 2191}# - (if #{rec?\ 2157}# - #{new-w\ 2187}# - #{w\ 2160}#)) - (#{trans-r\ 2192}# - (#{macros-only-env\ 371}# - #{r\ 2159}#))) - (map (lambda (#{x\ 2193}#) + (let ((#{w\ 2185}# + (if #{rec?\ 2151}# + #{new-w\ 2181}# + #{w\ 2154}#)) + (#{trans-r\ 2186}# + (#{macros-only-env\ 372}# + #{r\ 2153}#))) + (map (lambda (#{x\ 2187}#) (cons 'macro - (#{eval-local-transformer\ 473}# - (#{chi\ 461}# - #{x\ 2193}# - #{trans-r\ 2192}# - #{w\ 2191}# - #{mod\ 2162}#) - #{mod\ 2162}#))) - #{val\ 2178}#))) - #{r\ 2159}#) - #{new-w\ 2187}# - #{s\ 2161}# - #{mod\ 2162}#))))))))) - #{tmp\ 2172}#) - (let ((#{_\ 2198}# #{tmp\ 2171}#)) + (#{eval-local-transformer\ 472}# + (#{chi\ 460}# + #{x\ 2187}# + #{trans-r\ 2186}# + #{w\ 2185}# + #{mod\ 2156}#) + #{mod\ 2156}#))) + #{val\ 2172}#))) + #{r\ 2153}#) + #{new-w\ 2181}# + #{s\ 2155}# + #{mod\ 2156}#))))))))) + #{tmp\ 2166}#) + (let ((#{_\ 2192}# #{tmp\ 2165}#)) (syntax-violation #f "bad local syntax definition" - (#{source-wrap\ 447}# - #{e\ 2158}# - #{w\ 2160}# - #{s\ 2161}# - #{mod\ 2162}#)))))))) - (#{eval-local-transformer\ 473}# - (lambda (#{expanded\ 2199}# #{mod\ 2200}#) + (#{source-wrap\ 448}# + #{e\ 2152}# + #{w\ 2154}# + #{s\ 2155}# + #{mod\ 2156}#)))))))) + (#{eval-local-transformer\ 472}# + (lambda (#{expanded\ 2193}# #{mod\ 2194}#) (begin - (let ((#{p\ 2204}# - (#{local-eval-hook\ 292}# - #{expanded\ 2199}# - #{mod\ 2200}#))) - (if (procedure? #{p\ 2204}#) - #{p\ 2204}# + (let ((#{p\ 2198}# + (#{local-eval-hook\ 293}# + #{expanded\ 2193}# + #{mod\ 2194}#))) + (if (procedure? #{p\ 2198}#) + #{p\ 2198}# (syntax-violation #f "nonprocedure transformer" - #{p\ 2204}#)))))) - (#{chi-void\ 475}# - (lambda () (#{build-void\ 303}# #f))) - (#{ellipsis?\ 477}# - (lambda (#{x\ 2206}#) - (if (#{nonsymbol-id?\ 377}# #{x\ 2206}#) - (#{free-id=?\ 435}# - #{x\ 2206}# + #{p\ 2198}#)))))) + (#{chi-void\ 474}# + (lambda () (#{build-void\ 304}# #f))) + (#{ellipsis?\ 476}# + (lambda (#{x\ 2200}#) + (if (#{nonsymbol-id?\ 378}# #{x\ 2200}#) + (#{free-id=?\ 436}# + #{x\ 2200}# '#(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i2207")) + #(ribcage #(x) #((top)) #("i2201")) #(ribcage (lambda-var-list gen-var @@ -6453,7 +6496,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -6709,60 +6751,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -6771,347 +6812,346 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) #f))) - (#{lambda-formals\ 479}# - (lambda (#{orig-args\ 2210}#) + (#{lambda-formals\ 478}# + (lambda (#{orig-args\ 2204}#) (letrec* - ((#{req\ 2213}# - (lambda (#{args\ 2216}# #{rreq\ 2217}#) - (let ((#{tmp\ 2220}# #{args\ 2216}#)) - (let ((#{tmp\ 2221}# ($sc-dispatch #{tmp\ 2220}# '()))) - (if #{tmp\ 2221}# + ((#{req\ 2207}# + (lambda (#{args\ 2210}# #{rreq\ 2211}#) + (let ((#{tmp\ 2214}# #{args\ 2210}#)) + (let ((#{tmp\ 2215}# ($sc-dispatch #{tmp\ 2214}# '()))) + (if #{tmp\ 2215}# (@apply (lambda () - (#{check\ 2215}# (reverse #{rreq\ 2217}#) #f)) - #{tmp\ 2221}#) - (let ((#{tmp\ 2222}# - ($sc-dispatch #{tmp\ 2220}# '(any . any)))) - (if (if #{tmp\ 2222}# + (#{check\ 2209}# (reverse #{rreq\ 2211}#) #f)) + #{tmp\ 2215}#) + (let ((#{tmp\ 2216}# + ($sc-dispatch #{tmp\ 2214}# '(any . any)))) + (if (if #{tmp\ 2216}# (@apply - (lambda (#{a\ 2225}# #{b\ 2226}#) - (#{id?\ 379}# #{a\ 2225}#)) - #{tmp\ 2222}#) + (lambda (#{a\ 2219}# #{b\ 2220}#) + (#{id?\ 380}# #{a\ 2219}#)) + #{tmp\ 2216}#) #f) (@apply - (lambda (#{a\ 2229}# #{b\ 2230}#) - (#{req\ 2213}# - #{b\ 2230}# - (cons #{a\ 2229}# #{rreq\ 2217}#))) - #{tmp\ 2222}#) - (let ((#{tmp\ 2231}# (list #{tmp\ 2220}#))) - (if (if #{tmp\ 2231}# + (lambda (#{a\ 2223}# #{b\ 2224}#) + (#{req\ 2207}# + #{b\ 2224}# + (cons #{a\ 2223}# #{rreq\ 2211}#))) + #{tmp\ 2216}#) + (let ((#{tmp\ 2225}# (list #{tmp\ 2214}#))) + (if (if #{tmp\ 2225}# (@apply - (lambda (#{r\ 2233}#) - (#{id?\ 379}# #{r\ 2233}#)) - #{tmp\ 2231}#) + (lambda (#{r\ 2227}#) + (#{id?\ 380}# #{r\ 2227}#)) + #{tmp\ 2225}#) #f) (@apply - (lambda (#{r\ 2235}#) - (#{check\ 2215}# - (reverse #{rreq\ 2217}#) - #{r\ 2235}#)) - #{tmp\ 2231}#) - (let ((#{else\ 2237}# #{tmp\ 2220}#)) + (lambda (#{r\ 2229}#) + (#{check\ 2209}# + (reverse #{rreq\ 2211}#) + #{r\ 2229}#)) + #{tmp\ 2225}#) + (let ((#{else\ 2231}# #{tmp\ 2214}#)) (syntax-violation 'lambda "invalid argument list" - #{orig-args\ 2210}# - #{args\ 2216}#))))))))))) - (#{check\ 2215}# - (lambda (#{req\ 2238}# #{rest\ 2239}#) - (if (#{distinct-bound-ids?\ 441}# - (if #{rest\ 2239}# - (cons #{rest\ 2239}# #{req\ 2238}#) - #{req\ 2238}#)) - (values #{req\ 2238}# #f #{rest\ 2239}# #f) + #{orig-args\ 2204}# + #{args\ 2210}#))))))))))) + (#{check\ 2209}# + (lambda (#{req\ 2232}# #{rest\ 2233}#) + (if (#{distinct-bound-ids?\ 442}# + (if #{rest\ 2233}# + (cons #{rest\ 2233}# #{req\ 2232}#) + #{req\ 2232}#)) + (values #{req\ 2232}# #f #{rest\ 2233}# #f) (syntax-violation 'lambda "duplicate identifier in argument list" - #{orig-args\ 2210}#))))) - (begin (#{req\ 2213}# #{orig-args\ 2210}# '()))))) - (#{chi-simple-lambda\ 481}# - (lambda (#{e\ 2245}# - #{r\ 2246}# - #{w\ 2247}# - #{s\ 2248}# - #{mod\ 2249}# - #{req\ 2250}# - #{rest\ 2251}# - #{meta\ 2252}# - #{body\ 2253}#) + #{orig-args\ 2204}#))))) + (begin (#{req\ 2207}# #{orig-args\ 2204}# '()))))) + (#{chi-simple-lambda\ 480}# + (lambda (#{e\ 2239}# + #{r\ 2240}# + #{w\ 2241}# + #{s\ 2242}# + #{mod\ 2243}# + #{req\ 2244}# + #{rest\ 2245}# + #{meta\ 2246}# + #{body\ 2247}#) (begin - (let ((#{ids\ 2265}# - (if #{rest\ 2251}# - (append #{req\ 2250}# (list #{rest\ 2251}#)) - #{req\ 2250}#))) + (let ((#{ids\ 2259}# + (if #{rest\ 2245}# + (append #{req\ 2244}# (list #{rest\ 2245}#)) + #{req\ 2244}#))) (begin - (let ((#{vars\ 2267}# - (map #{gen-var\ 489}# #{ids\ 2265}#))) + (let ((#{vars\ 2261}# + (map #{gen-var\ 488}# #{ids\ 2259}#))) (begin - (let ((#{labels\ 2269}# - (#{gen-labels\ 394}# #{ids\ 2265}#))) - (#{build-simple-lambda\ 323}# - #{s\ 2248}# - (map syntax->datum #{req\ 2250}#) - (if #{rest\ 2251}# - (syntax->datum #{rest\ 2251}#) + (let ((#{labels\ 2263}# + (#{gen-labels\ 395}# #{ids\ 2259}#))) + (#{build-simple-lambda\ 324}# + #{s\ 2242}# + (map syntax->datum #{req\ 2244}#) + (if #{rest\ 2245}# + (syntax->datum #{rest\ 2245}#) #f) - #{vars\ 2267}# - #{meta\ 2252}# - (#{chi-body\ 469}# - #{body\ 2253}# - (#{source-wrap\ 447}# - #{e\ 2245}# - #{w\ 2247}# - #{s\ 2248}# - #{mod\ 2249}#) - (#{extend-var-env\ 369}# - #{labels\ 2269}# - #{vars\ 2267}# - #{r\ 2246}#) - (#{make-binding-wrap\ 423}# - #{ids\ 2265}# - #{labels\ 2269}# - #{w\ 2247}#) - #{mod\ 2249}#)))))))))) - (#{lambda*-formals\ 483}# - (lambda (#{orig-args\ 2272}#) + #{vars\ 2261}# + #{meta\ 2246}# + (#{chi-body\ 468}# + #{body\ 2247}# + (#{source-wrap\ 448}# + #{e\ 2239}# + #{w\ 2241}# + #{s\ 2242}# + #{mod\ 2243}#) + (#{extend-var-env\ 370}# + #{labels\ 2263}# + #{vars\ 2261}# + #{r\ 2240}#) + (#{make-binding-wrap\ 424}# + #{ids\ 2259}# + #{labels\ 2263}# + #{w\ 2241}#) + #{mod\ 2243}#)))))))))) + (#{lambda*-formals\ 482}# + (lambda (#{orig-args\ 2266}#) (letrec* - ((#{req\ 2275}# - (lambda (#{args\ 2284}# #{rreq\ 2285}#) - (let ((#{tmp\ 2288}# #{args\ 2284}#)) - (let ((#{tmp\ 2289}# ($sc-dispatch #{tmp\ 2288}# '()))) - (if #{tmp\ 2289}# + ((#{req\ 2269}# + (lambda (#{args\ 2278}# #{rreq\ 2279}#) + (let ((#{tmp\ 2282}# #{args\ 2278}#)) + (let ((#{tmp\ 2283}# ($sc-dispatch #{tmp\ 2282}# '()))) + (if #{tmp\ 2283}# (@apply (lambda () - (#{check\ 2283}# - (reverse #{rreq\ 2285}#) + (#{check\ 2277}# + (reverse #{rreq\ 2279}#) '() #f '())) - #{tmp\ 2289}#) - (let ((#{tmp\ 2290}# - ($sc-dispatch #{tmp\ 2288}# '(any . any)))) - (if (if #{tmp\ 2290}# + #{tmp\ 2283}#) + (let ((#{tmp\ 2284}# + ($sc-dispatch #{tmp\ 2282}# '(any . any)))) + (if (if #{tmp\ 2284}# (@apply - (lambda (#{a\ 2293}# #{b\ 2294}#) - (#{id?\ 379}# #{a\ 2293}#)) - #{tmp\ 2290}#) + (lambda (#{a\ 2287}# #{b\ 2288}#) + (#{id?\ 380}# #{a\ 2287}#)) + #{tmp\ 2284}#) #f) (@apply - (lambda (#{a\ 2297}# #{b\ 2298}#) - (#{req\ 2275}# - #{b\ 2298}# - (cons #{a\ 2297}# #{rreq\ 2285}#))) - #{tmp\ 2290}#) - (let ((#{tmp\ 2299}# + (lambda (#{a\ 2291}# #{b\ 2292}#) + (#{req\ 2269}# + #{b\ 2292}# + (cons #{a\ 2291}# #{rreq\ 2279}#))) + #{tmp\ 2284}#) + (let ((#{tmp\ 2293}# ($sc-dispatch - #{tmp\ 2288}# + #{tmp\ 2282}# '(any . any)))) - (if (if #{tmp\ 2299}# + (if (if #{tmp\ 2293}# (@apply - (lambda (#{a\ 2302}# #{b\ 2303}#) - (eq? (syntax->datum #{a\ 2302}#) + (lambda (#{a\ 2296}# #{b\ 2297}#) + (eq? (syntax->datum #{a\ 2296}#) #:optional)) - #{tmp\ 2299}#) + #{tmp\ 2293}#) #f) (@apply - (lambda (#{a\ 2306}# #{b\ 2307}#) - (#{opt\ 2277}# - #{b\ 2307}# - (reverse #{rreq\ 2285}#) + (lambda (#{a\ 2300}# #{b\ 2301}#) + (#{opt\ 2271}# + #{b\ 2301}# + (reverse #{rreq\ 2279}#) '())) - #{tmp\ 2299}#) - (let ((#{tmp\ 2308}# + #{tmp\ 2293}#) + (let ((#{tmp\ 2302}# ($sc-dispatch - #{tmp\ 2288}# + #{tmp\ 2282}# '(any . any)))) - (if (if #{tmp\ 2308}# + (if (if #{tmp\ 2302}# (@apply - (lambda (#{a\ 2311}# #{b\ 2312}#) - (eq? (syntax->datum #{a\ 2311}#) + (lambda (#{a\ 2305}# #{b\ 2306}#) + (eq? (syntax->datum #{a\ 2305}#) #:key)) - #{tmp\ 2308}#) + #{tmp\ 2302}#) #f) (@apply - (lambda (#{a\ 2315}# #{b\ 2316}#) - (#{key\ 2279}# - #{b\ 2316}# - (reverse #{rreq\ 2285}#) + (lambda (#{a\ 2309}# #{b\ 2310}#) + (#{key\ 2273}# + #{b\ 2310}# + (reverse #{rreq\ 2279}#) '() '())) - #{tmp\ 2308}#) - (let ((#{tmp\ 2317}# + #{tmp\ 2302}#) + (let ((#{tmp\ 2311}# ($sc-dispatch - #{tmp\ 2288}# + #{tmp\ 2282}# '(any any)))) - (if (if #{tmp\ 2317}# + (if (if #{tmp\ 2311}# (@apply - (lambda (#{a\ 2320}# - #{b\ 2321}#) + (lambda (#{a\ 2314}# + #{b\ 2315}#) (eq? (syntax->datum - #{a\ 2320}#) + #{a\ 2314}#) #:rest)) - #{tmp\ 2317}#) + #{tmp\ 2311}#) #f) (@apply - (lambda (#{a\ 2324}# #{b\ 2325}#) - (#{rest\ 2281}# - #{b\ 2325}# - (reverse #{rreq\ 2285}#) + (lambda (#{a\ 2318}# #{b\ 2319}#) + (#{rest\ 2275}# + #{b\ 2319}# + (reverse #{rreq\ 2279}#) '() '())) - #{tmp\ 2317}#) - (let ((#{tmp\ 2326}# - (list #{tmp\ 2288}#))) - (if (if #{tmp\ 2326}# + #{tmp\ 2311}#) + (let ((#{tmp\ 2320}# + (list #{tmp\ 2282}#))) + (if (if #{tmp\ 2320}# (@apply - (lambda (#{r\ 2328}#) - (#{id?\ 379}# - #{r\ 2328}#)) - #{tmp\ 2326}#) + (lambda (#{r\ 2322}#) + (#{id?\ 380}# + #{r\ 2322}#)) + #{tmp\ 2320}#) #f) (@apply - (lambda (#{r\ 2330}#) - (#{rest\ 2281}# - #{r\ 2330}# - (reverse #{rreq\ 2285}#) + (lambda (#{r\ 2324}#) + (#{rest\ 2275}# + #{r\ 2324}# + (reverse #{rreq\ 2279}#) '() '())) - #{tmp\ 2326}#) - (let ((#{else\ 2332}# - #{tmp\ 2288}#)) + #{tmp\ 2320}#) + (let ((#{else\ 2326}# + #{tmp\ 2282}#)) (syntax-violation 'lambda* "invalid argument list" - #{orig-args\ 2272}# - #{args\ 2284}#))))))))))))))))) - (#{opt\ 2277}# - (lambda (#{args\ 2333}# #{req\ 2334}# #{ropt\ 2335}#) - (let ((#{tmp\ 2339}# #{args\ 2333}#)) - (let ((#{tmp\ 2340}# ($sc-dispatch #{tmp\ 2339}# '()))) - (if #{tmp\ 2340}# + #{orig-args\ 2266}# + #{args\ 2278}#))))))))))))))))) + (#{opt\ 2271}# + (lambda (#{args\ 2327}# #{req\ 2328}# #{ropt\ 2329}#) + (let ((#{tmp\ 2333}# #{args\ 2327}#)) + (let ((#{tmp\ 2334}# ($sc-dispatch #{tmp\ 2333}# '()))) + (if #{tmp\ 2334}# (@apply (lambda () - (#{check\ 2283}# - #{req\ 2334}# - (reverse #{ropt\ 2335}#) + (#{check\ 2277}# + #{req\ 2328}# + (reverse #{ropt\ 2329}#) #f '())) - #{tmp\ 2340}#) - (let ((#{tmp\ 2341}# - ($sc-dispatch #{tmp\ 2339}# '(any . any)))) - (if (if #{tmp\ 2341}# + #{tmp\ 2334}#) + (let ((#{tmp\ 2335}# + ($sc-dispatch #{tmp\ 2333}# '(any . any)))) + (if (if #{tmp\ 2335}# (@apply - (lambda (#{a\ 2344}# #{b\ 2345}#) - (#{id?\ 379}# #{a\ 2344}#)) - #{tmp\ 2341}#) + (lambda (#{a\ 2338}# #{b\ 2339}#) + (#{id?\ 380}# #{a\ 2338}#)) + #{tmp\ 2335}#) #f) (@apply - (lambda (#{a\ 2348}# #{b\ 2349}#) - (#{opt\ 2277}# - #{b\ 2349}# - #{req\ 2334}# - (cons (cons #{a\ 2348}# + (lambda (#{a\ 2342}# #{b\ 2343}#) + (#{opt\ 2271}# + #{b\ 2343}# + #{req\ 2328}# + (cons (cons #{a\ 2342}# '(#(syntax-object #f ((top) #(ribcage #(a b) #((top) (top)) - #("i2346" "i2347")) + #("i2340" "i2341")) #(ribcage () () ()) #(ribcage #(args req ropt) #((top) (top) (top)) - #("i2336" - "i2337" - "i2338")) + #("i2330" + "i2331" + "i2332")) #(ribcage (check rest key opt req) ((top) @@ -7119,15 +7159,15 @@ (top) (top) (top)) - ("i2282" - "i2280" - "i2278" - "i2276" - "i2274")) + ("i2276" + "i2274" + "i2272" + "i2270" + "i2268")) #(ribcage #(orig-args) #((top)) - #("i2273")) + #("i2267")) #(ribcage (lambda-var-list gen-var @@ -7145,7 +7185,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -7401,60 +7440,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -7463,83 +7501,82 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors @@ -7549,147 +7586,147 @@ (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile)))) - #{ropt\ 2335}#))) - #{tmp\ 2341}#) - (let ((#{tmp\ 2350}# + #{ropt\ 2329}#))) + #{tmp\ 2335}#) + (let ((#{tmp\ 2344}# ($sc-dispatch - #{tmp\ 2339}# + #{tmp\ 2333}# '((any any) . any)))) - (if (if #{tmp\ 2350}# + (if (if #{tmp\ 2344}# (@apply - (lambda (#{a\ 2354}# - #{init\ 2355}# - #{b\ 2356}#) - (#{id?\ 379}# #{a\ 2354}#)) - #{tmp\ 2350}#) + (lambda (#{a\ 2348}# + #{init\ 2349}# + #{b\ 2350}#) + (#{id?\ 380}# #{a\ 2348}#)) + #{tmp\ 2344}#) #f) (@apply - (lambda (#{a\ 2360}# - #{init\ 2361}# - #{b\ 2362}#) - (#{opt\ 2277}# - #{b\ 2362}# - #{req\ 2334}# - (cons (list #{a\ 2360}# #{init\ 2361}#) - #{ropt\ 2335}#))) - #{tmp\ 2350}#) - (let ((#{tmp\ 2363}# + (lambda (#{a\ 2354}# + #{init\ 2355}# + #{b\ 2356}#) + (#{opt\ 2271}# + #{b\ 2356}# + #{req\ 2328}# + (cons (list #{a\ 2354}# #{init\ 2355}#) + #{ropt\ 2329}#))) + #{tmp\ 2344}#) + (let ((#{tmp\ 2357}# ($sc-dispatch - #{tmp\ 2339}# + #{tmp\ 2333}# '(any . any)))) - (if (if #{tmp\ 2363}# + (if (if #{tmp\ 2357}# (@apply - (lambda (#{a\ 2366}# #{b\ 2367}#) - (eq? (syntax->datum #{a\ 2366}#) + (lambda (#{a\ 2360}# #{b\ 2361}#) + (eq? (syntax->datum #{a\ 2360}#) #:key)) - #{tmp\ 2363}#) + #{tmp\ 2357}#) #f) (@apply - (lambda (#{a\ 2370}# #{b\ 2371}#) - (#{key\ 2279}# - #{b\ 2371}# - #{req\ 2334}# - (reverse #{ropt\ 2335}#) + (lambda (#{a\ 2364}# #{b\ 2365}#) + (#{key\ 2273}# + #{b\ 2365}# + #{req\ 2328}# + (reverse #{ropt\ 2329}#) '())) - #{tmp\ 2363}#) - (let ((#{tmp\ 2372}# + #{tmp\ 2357}#) + (let ((#{tmp\ 2366}# ($sc-dispatch - #{tmp\ 2339}# + #{tmp\ 2333}# '(any any)))) - (if (if #{tmp\ 2372}# + (if (if #{tmp\ 2366}# (@apply - (lambda (#{a\ 2375}# - #{b\ 2376}#) + (lambda (#{a\ 2369}# + #{b\ 2370}#) (eq? (syntax->datum - #{a\ 2375}#) + #{a\ 2369}#) #:rest)) - #{tmp\ 2372}#) + #{tmp\ 2366}#) #f) (@apply - (lambda (#{a\ 2379}# #{b\ 2380}#) - (#{rest\ 2281}# - #{b\ 2380}# - #{req\ 2334}# - (reverse #{ropt\ 2335}#) + (lambda (#{a\ 2373}# #{b\ 2374}#) + (#{rest\ 2275}# + #{b\ 2374}# + #{req\ 2328}# + (reverse #{ropt\ 2329}#) '())) - #{tmp\ 2372}#) - (let ((#{tmp\ 2381}# - (list #{tmp\ 2339}#))) - (if (if #{tmp\ 2381}# + #{tmp\ 2366}#) + (let ((#{tmp\ 2375}# + (list #{tmp\ 2333}#))) + (if (if #{tmp\ 2375}# (@apply - (lambda (#{r\ 2383}#) - (#{id?\ 379}# - #{r\ 2383}#)) - #{tmp\ 2381}#) + (lambda (#{r\ 2377}#) + (#{id?\ 380}# + #{r\ 2377}#)) + #{tmp\ 2375}#) #f) (@apply - (lambda (#{r\ 2385}#) - (#{rest\ 2281}# - #{r\ 2385}# - #{req\ 2334}# - (reverse #{ropt\ 2335}#) + (lambda (#{r\ 2379}#) + (#{rest\ 2275}# + #{r\ 2379}# + #{req\ 2328}# + (reverse #{ropt\ 2329}#) '())) - #{tmp\ 2381}#) - (let ((#{else\ 2387}# - #{tmp\ 2339}#)) + #{tmp\ 2375}#) + (let ((#{else\ 2381}# + #{tmp\ 2333}#)) (syntax-violation 'lambda* "invalid optional argument list" - #{orig-args\ 2272}# - #{args\ 2333}#))))))))))))))))) - (#{key\ 2279}# - (lambda (#{args\ 2388}# - #{req\ 2389}# - #{opt\ 2390}# - #{rkey\ 2391}#) - (let ((#{tmp\ 2396}# #{args\ 2388}#)) - (let ((#{tmp\ 2397}# ($sc-dispatch #{tmp\ 2396}# '()))) - (if #{tmp\ 2397}# + #{orig-args\ 2266}# + #{args\ 2327}#))))))))))))))))) + (#{key\ 2273}# + (lambda (#{args\ 2382}# + #{req\ 2383}# + #{opt\ 2384}# + #{rkey\ 2385}#) + (let ((#{tmp\ 2390}# #{args\ 2382}#)) + (let ((#{tmp\ 2391}# ($sc-dispatch #{tmp\ 2390}# '()))) + (if #{tmp\ 2391}# (@apply (lambda () - (#{check\ 2283}# - #{req\ 2389}# - #{opt\ 2390}# + (#{check\ 2277}# + #{req\ 2383}# + #{opt\ 2384}# #f - (cons #f (reverse #{rkey\ 2391}#)))) - #{tmp\ 2397}#) - (let ((#{tmp\ 2398}# - ($sc-dispatch #{tmp\ 2396}# '(any . any)))) - (if (if #{tmp\ 2398}# + (cons #f (reverse #{rkey\ 2385}#)))) + #{tmp\ 2391}#) + (let ((#{tmp\ 2392}# + ($sc-dispatch #{tmp\ 2390}# '(any . any)))) + (if (if #{tmp\ 2392}# (@apply - (lambda (#{a\ 2401}# #{b\ 2402}#) - (#{id?\ 379}# #{a\ 2401}#)) - #{tmp\ 2398}#) + (lambda (#{a\ 2395}# #{b\ 2396}#) + (#{id?\ 380}# #{a\ 2395}#)) + #{tmp\ 2392}#) #f) (@apply - (lambda (#{a\ 2405}# #{b\ 2406}#) - (let ((#{tmp\ 2408}# + (lambda (#{a\ 2399}# #{b\ 2400}#) + (let ((#{tmp\ 2402}# (symbol->keyword - (syntax->datum #{a\ 2405}#)))) - (let ((#{k\ 2410}# #{tmp\ 2408}#)) - (#{key\ 2279}# - #{b\ 2406}# - #{req\ 2389}# - #{opt\ 2390}# - (cons (cons #{k\ 2410}# - (cons #{a\ 2405}# + (syntax->datum #{a\ 2399}#)))) + (let ((#{k\ 2404}# #{tmp\ 2402}#)) + (#{key\ 2273}# + #{b\ 2400}# + #{req\ 2383}# + #{opt\ 2384}# + (cons (cons #{k\ 2404}# + (cons #{a\ 2399}# '(#(syntax-object #f ((top) #(ribcage #(k) #((top)) - #("i2409")) + #("i2403")) #(ribcage #(a b) #((top) (top)) - #("i2403" - "i2404")) + #("i2397" + "i2398")) #(ribcage () () @@ -7703,10 +7740,10 @@ (top) (top) (top)) - #("i2392" - "i2393" - "i2394" - "i2395")) + #("i2386" + "i2387" + "i2388" + "i2389")) #(ribcage (check rest key @@ -7717,15 +7754,15 @@ (top) (top) (top)) - ("i2282" - "i2280" - "i2278" - "i2276" - "i2274")) + ("i2276" + "i2274" + "i2272" + "i2270" + "i2268")) #(ribcage #(orig-args) #((top)) - #("i2273")) + #("i2267")) #(ribcage (lambda-var-list gen-var @@ -7743,7 +7780,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -7999,60 +8035,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -8061,83 +8096,82 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors @@ -8147,2038 +8181,2038 @@ (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile))))) - #{rkey\ 2391}#))))) - #{tmp\ 2398}#) - (let ((#{tmp\ 2411}# + #{rkey\ 2385}#))))) + #{tmp\ 2392}#) + (let ((#{tmp\ 2405}# ($sc-dispatch - #{tmp\ 2396}# + #{tmp\ 2390}# '((any any) . any)))) - (if (if #{tmp\ 2411}# + (if (if #{tmp\ 2405}# (@apply - (lambda (#{a\ 2415}# - #{init\ 2416}# - #{b\ 2417}#) - (#{id?\ 379}# #{a\ 2415}#)) - #{tmp\ 2411}#) + (lambda (#{a\ 2409}# + #{init\ 2410}# + #{b\ 2411}#) + (#{id?\ 380}# #{a\ 2409}#)) + #{tmp\ 2405}#) #f) (@apply - (lambda (#{a\ 2421}# - #{init\ 2422}# - #{b\ 2423}#) - (let ((#{tmp\ 2425}# + (lambda (#{a\ 2415}# + #{init\ 2416}# + #{b\ 2417}#) + (let ((#{tmp\ 2419}# (symbol->keyword - (syntax->datum #{a\ 2421}#)))) - (let ((#{k\ 2427}# #{tmp\ 2425}#)) - (#{key\ 2279}# - #{b\ 2423}# - #{req\ 2389}# - #{opt\ 2390}# - (cons (list #{k\ 2427}# - #{a\ 2421}# - #{init\ 2422}#) - #{rkey\ 2391}#))))) - #{tmp\ 2411}#) - (let ((#{tmp\ 2428}# + (syntax->datum #{a\ 2415}#)))) + (let ((#{k\ 2421}# #{tmp\ 2419}#)) + (#{key\ 2273}# + #{b\ 2417}# + #{req\ 2383}# + #{opt\ 2384}# + (cons (list #{k\ 2421}# + #{a\ 2415}# + #{init\ 2416}#) + #{rkey\ 2385}#))))) + #{tmp\ 2405}#) + (let ((#{tmp\ 2422}# ($sc-dispatch - #{tmp\ 2396}# + #{tmp\ 2390}# '((any any any) . any)))) - (if (if #{tmp\ 2428}# + (if (if #{tmp\ 2422}# (@apply - (lambda (#{a\ 2433}# - #{init\ 2434}# - #{k\ 2435}# - #{b\ 2436}#) - (if (#{id?\ 379}# #{a\ 2433}#) + (lambda (#{a\ 2427}# + #{init\ 2428}# + #{k\ 2429}# + #{b\ 2430}#) + (if (#{id?\ 380}# #{a\ 2427}#) (keyword? - (syntax->datum #{k\ 2435}#)) + (syntax->datum #{k\ 2429}#)) #f)) - #{tmp\ 2428}#) + #{tmp\ 2422}#) #f) (@apply - (lambda (#{a\ 2443}# - #{init\ 2444}# - #{k\ 2445}# - #{b\ 2446}#) - (#{key\ 2279}# - #{b\ 2446}# - #{req\ 2389}# - #{opt\ 2390}# - (cons (list #{k\ 2445}# - #{a\ 2443}# - #{init\ 2444}#) - #{rkey\ 2391}#))) - #{tmp\ 2428}#) - (let ((#{tmp\ 2447}# + (lambda (#{a\ 2437}# + #{init\ 2438}# + #{k\ 2439}# + #{b\ 2440}#) + (#{key\ 2273}# + #{b\ 2440}# + #{req\ 2383}# + #{opt\ 2384}# + (cons (list #{k\ 2439}# + #{a\ 2437}# + #{init\ 2438}#) + #{rkey\ 2385}#))) + #{tmp\ 2422}#) + (let ((#{tmp\ 2441}# ($sc-dispatch - #{tmp\ 2396}# + #{tmp\ 2390}# '(any)))) - (if (if #{tmp\ 2447}# + (if (if #{tmp\ 2441}# (@apply - (lambda (#{aok\ 2449}#) + (lambda (#{aok\ 2443}#) (eq? (syntax->datum - #{aok\ 2449}#) + #{aok\ 2443}#) #:allow-other-keys)) - #{tmp\ 2447}#) + #{tmp\ 2441}#) #f) (@apply - (lambda (#{aok\ 2451}#) - (#{check\ 2283}# - #{req\ 2389}# - #{opt\ 2390}# + (lambda (#{aok\ 2445}#) + (#{check\ 2277}# + #{req\ 2383}# + #{opt\ 2384}# #f (cons #t (reverse - #{rkey\ 2391}#)))) - #{tmp\ 2447}#) - (let ((#{tmp\ 2452}# + #{rkey\ 2385}#)))) + #{tmp\ 2441}#) + (let ((#{tmp\ 2446}# ($sc-dispatch - #{tmp\ 2396}# + #{tmp\ 2390}# '(any any any)))) - (if (if #{tmp\ 2452}# + (if (if #{tmp\ 2446}# (@apply - (lambda (#{aok\ 2456}# - #{a\ 2457}# - #{b\ 2458}#) + (lambda (#{aok\ 2450}# + #{a\ 2451}# + #{b\ 2452}#) (if (eq? (syntax->datum - #{aok\ 2456}#) + #{aok\ 2450}#) #:allow-other-keys) (eq? (syntax->datum - #{a\ 2457}#) + #{a\ 2451}#) #:rest) #f)) - #{tmp\ 2452}#) + #{tmp\ 2446}#) #f) (@apply - (lambda (#{aok\ 2464}# - #{a\ 2465}# - #{b\ 2466}#) - (#{rest\ 2281}# - #{b\ 2466}# - #{req\ 2389}# - #{opt\ 2390}# + (lambda (#{aok\ 2458}# + #{a\ 2459}# + #{b\ 2460}#) + (#{rest\ 2275}# + #{b\ 2460}# + #{req\ 2383}# + #{opt\ 2384}# (cons #t (reverse - #{rkey\ 2391}#)))) - #{tmp\ 2452}#) - (let ((#{tmp\ 2467}# + #{rkey\ 2385}#)))) + #{tmp\ 2446}#) + (let ((#{tmp\ 2461}# ($sc-dispatch - #{tmp\ 2396}# + #{tmp\ 2390}# '(any . any)))) - (if (if #{tmp\ 2467}# + (if (if #{tmp\ 2461}# (@apply - (lambda (#{aok\ 2470}# - #{r\ 2471}#) + (lambda (#{aok\ 2464}# + #{r\ 2465}#) (if (eq? (syntax->datum - #{aok\ 2470}#) + #{aok\ 2464}#) #:allow-other-keys) - (#{id?\ 379}# - #{r\ 2471}#) + (#{id?\ 380}# + #{r\ 2465}#) #f)) - #{tmp\ 2467}#) + #{tmp\ 2461}#) #f) (@apply - (lambda (#{aok\ 2476}# - #{r\ 2477}#) - (#{rest\ 2281}# - #{r\ 2477}# - #{req\ 2389}# - #{opt\ 2390}# + (lambda (#{aok\ 2470}# + #{r\ 2471}#) + (#{rest\ 2275}# + #{r\ 2471}# + #{req\ 2383}# + #{opt\ 2384}# (cons #t (reverse - #{rkey\ 2391}#)))) - #{tmp\ 2467}#) - (let ((#{tmp\ 2478}# + #{rkey\ 2385}#)))) + #{tmp\ 2461}#) + (let ((#{tmp\ 2472}# ($sc-dispatch - #{tmp\ 2396}# + #{tmp\ 2390}# '(any any)))) - (if (if #{tmp\ 2478}# + (if (if #{tmp\ 2472}# (@apply - (lambda (#{a\ 2481}# - #{b\ 2482}#) + (lambda (#{a\ 2475}# + #{b\ 2476}#) (eq? (syntax->datum - #{a\ 2481}#) + #{a\ 2475}#) #:rest)) - #{tmp\ 2478}#) + #{tmp\ 2472}#) #f) (@apply - (lambda (#{a\ 2485}# - #{b\ 2486}#) - (#{rest\ 2281}# - #{b\ 2486}# - #{req\ 2389}# - #{opt\ 2390}# + (lambda (#{a\ 2479}# + #{b\ 2480}#) + (#{rest\ 2275}# + #{b\ 2480}# + #{req\ 2383}# + #{opt\ 2384}# (cons #f (reverse - #{rkey\ 2391}#)))) - #{tmp\ 2478}#) - (let ((#{tmp\ 2487}# - (list #{tmp\ 2396}#))) - (if (if #{tmp\ 2487}# + #{rkey\ 2385}#)))) + #{tmp\ 2472}#) + (let ((#{tmp\ 2481}# + (list #{tmp\ 2390}#))) + (if (if #{tmp\ 2481}# (@apply - (lambda (#{r\ 2489}#) - (#{id?\ 379}# - #{r\ 2489}#)) - #{tmp\ 2487}#) + (lambda (#{r\ 2483}#) + (#{id?\ 380}# + #{r\ 2483}#)) + #{tmp\ 2481}#) #f) (@apply - (lambda (#{r\ 2491}#) - (#{rest\ 2281}# - #{r\ 2491}# - #{req\ 2389}# - #{opt\ 2390}# + (lambda (#{r\ 2485}#) + (#{rest\ 2275}# + #{r\ 2485}# + #{req\ 2383}# + #{opt\ 2384}# (cons #f (reverse - #{rkey\ 2391}#)))) - #{tmp\ 2487}#) - (let ((#{else\ 2493}# - #{tmp\ 2396}#)) + #{rkey\ 2385}#)))) + #{tmp\ 2481}#) + (let ((#{else\ 2487}# + #{tmp\ 2390}#)) (syntax-violation 'lambda* "invalid keyword argument list" - #{orig-args\ 2272}# - #{args\ 2388}#))))))))))))))))))))))) - (#{rest\ 2281}# - (lambda (#{args\ 2494}# - #{req\ 2495}# - #{opt\ 2496}# - #{kw\ 2497}#) - (let ((#{tmp\ 2502}# #{args\ 2494}#)) - (let ((#{tmp\ 2503}# (list #{tmp\ 2502}#))) - (if (if #{tmp\ 2503}# + #{orig-args\ 2266}# + #{args\ 2382}#))))))))))))))))))))))) + (#{rest\ 2275}# + (lambda (#{args\ 2488}# + #{req\ 2489}# + #{opt\ 2490}# + #{kw\ 2491}#) + (let ((#{tmp\ 2496}# #{args\ 2488}#)) + (let ((#{tmp\ 2497}# (list #{tmp\ 2496}#))) + (if (if #{tmp\ 2497}# (@apply - (lambda (#{r\ 2505}#) - (#{id?\ 379}# #{r\ 2505}#)) - #{tmp\ 2503}#) + (lambda (#{r\ 2499}#) + (#{id?\ 380}# #{r\ 2499}#)) + #{tmp\ 2497}#) #f) (@apply - (lambda (#{r\ 2507}#) - (#{check\ 2283}# - #{req\ 2495}# - #{opt\ 2496}# - #{r\ 2507}# - #{kw\ 2497}#)) - #{tmp\ 2503}#) - (let ((#{else\ 2509}# #{tmp\ 2502}#)) + (lambda (#{r\ 2501}#) + (#{check\ 2277}# + #{req\ 2489}# + #{opt\ 2490}# + #{r\ 2501}# + #{kw\ 2491}#)) + #{tmp\ 2497}#) + (let ((#{else\ 2503}# #{tmp\ 2496}#)) (syntax-violation 'lambda* "invalid rest argument" - #{orig-args\ 2272}# - #{args\ 2494}#))))))) - (#{check\ 2283}# - (lambda (#{req\ 2510}# - #{opt\ 2511}# - #{rest\ 2512}# - #{kw\ 2513}#) - (if (#{distinct-bound-ids?\ 441}# + #{orig-args\ 2266}# + #{args\ 2488}#))))))) + (#{check\ 2277}# + (lambda (#{req\ 2504}# + #{opt\ 2505}# + #{rest\ 2506}# + #{kw\ 2507}#) + (if (#{distinct-bound-ids?\ 442}# (append - #{req\ 2510}# - (map car #{opt\ 2511}#) - (if #{rest\ 2512}# (list #{rest\ 2512}#) '()) - (if (pair? #{kw\ 2513}#) - (map cadr (cdr #{kw\ 2513}#)) + #{req\ 2504}# + (map car #{opt\ 2505}#) + (if #{rest\ 2506}# (list #{rest\ 2506}#) '()) + (if (pair? #{kw\ 2507}#) + (map cadr (cdr #{kw\ 2507}#)) '()))) (values - #{req\ 2510}# - #{opt\ 2511}# - #{rest\ 2512}# - #{kw\ 2513}#) + #{req\ 2504}# + #{opt\ 2505}# + #{rest\ 2506}# + #{kw\ 2507}#) (syntax-violation 'lambda* "duplicate identifier in argument list" - #{orig-args\ 2272}#))))) - (begin (#{req\ 2275}# #{orig-args\ 2272}# '()))))) - (#{chi-lambda-case\ 485}# - (lambda (#{e\ 2521}# - #{r\ 2522}# - #{w\ 2523}# - #{s\ 2524}# - #{mod\ 2525}# - #{get-formals\ 2526}# - #{clauses\ 2527}#) + #{orig-args\ 2266}#))))) + (begin (#{req\ 2269}# #{orig-args\ 2266}# '()))))) + (#{chi-lambda-case\ 484}# + (lambda (#{e\ 2515}# + #{r\ 2516}# + #{w\ 2517}# + #{s\ 2518}# + #{mod\ 2519}# + #{get-formals\ 2520}# + #{clauses\ 2521}#) (letrec* - ((#{expand-req\ 2536}# - (lambda (#{req\ 2543}# - #{opt\ 2544}# - #{rest\ 2545}# - #{kw\ 2546}# - #{body\ 2547}#) + ((#{expand-req\ 2530}# + (lambda (#{req\ 2537}# + #{opt\ 2538}# + #{rest\ 2539}# + #{kw\ 2540}# + #{body\ 2541}#) (begin - (let ((#{vars\ 2555}# - (map #{gen-var\ 489}# #{req\ 2543}#)) - (#{labels\ 2556}# - (#{gen-labels\ 394}# #{req\ 2543}#))) + (let ((#{vars\ 2549}# + (map #{gen-var\ 488}# #{req\ 2537}#)) + (#{labels\ 2550}# + (#{gen-labels\ 395}# #{req\ 2537}#))) (begin - (let ((#{r*\ 2559}# - (#{extend-var-env\ 369}# - #{labels\ 2556}# - #{vars\ 2555}# - #{r\ 2522}#)) - (#{w*\ 2560}# - (#{make-binding-wrap\ 423}# - #{req\ 2543}# - #{labels\ 2556}# - #{w\ 2523}#))) - (#{expand-opt\ 2538}# - (map syntax->datum #{req\ 2543}#) - #{opt\ 2544}# - #{rest\ 2545}# - #{kw\ 2546}# - #{body\ 2547}# - (reverse #{vars\ 2555}#) - #{r*\ 2559}# - #{w*\ 2560}# + (let ((#{r*\ 2553}# + (#{extend-var-env\ 370}# + #{labels\ 2550}# + #{vars\ 2549}# + #{r\ 2516}#)) + (#{w*\ 2554}# + (#{make-binding-wrap\ 424}# + #{req\ 2537}# + #{labels\ 2550}# + #{w\ 2517}#))) + (#{expand-opt\ 2532}# + (map syntax->datum #{req\ 2537}#) + #{opt\ 2538}# + #{rest\ 2539}# + #{kw\ 2540}# + #{body\ 2541}# + (reverse #{vars\ 2549}#) + #{r*\ 2553}# + #{w*\ 2554}# '() '()))))))) - (#{expand-opt\ 2538}# - (lambda (#{req\ 2561}# - #{opt\ 2562}# - #{rest\ 2563}# - #{kw\ 2564}# - #{body\ 2565}# - #{vars\ 2566}# - #{r*\ 2567}# - #{w*\ 2568}# - #{out\ 2569}# - #{inits\ 2570}#) - (if (pair? #{opt\ 2562}#) - (let ((#{tmp\ 2583}# (car #{opt\ 2562}#))) - (let ((#{tmp\ 2584}# - ($sc-dispatch #{tmp\ 2583}# '(any any)))) - (if #{tmp\ 2584}# + (#{expand-opt\ 2532}# + (lambda (#{req\ 2555}# + #{opt\ 2556}# + #{rest\ 2557}# + #{kw\ 2558}# + #{body\ 2559}# + #{vars\ 2560}# + #{r*\ 2561}# + #{w*\ 2562}# + #{out\ 2563}# + #{inits\ 2564}#) + (if (pair? #{opt\ 2556}#) + (let ((#{tmp\ 2577}# (car #{opt\ 2556}#))) + (let ((#{tmp\ 2578}# + ($sc-dispatch #{tmp\ 2577}# '(any any)))) + (if #{tmp\ 2578}# (@apply - (lambda (#{id\ 2587}# #{i\ 2588}#) + (lambda (#{id\ 2581}# #{i\ 2582}#) (begin - (let ((#{v\ 2591}# - (#{gen-var\ 489}# #{id\ 2587}#))) + (let ((#{v\ 2585}# + (#{gen-var\ 488}# #{id\ 2581}#))) (begin - (let ((#{l\ 2593}# - (#{gen-labels\ 394}# - (list #{v\ 2591}#)))) + (let ((#{l\ 2587}# + (#{gen-labels\ 395}# + (list #{v\ 2585}#)))) (begin - (let ((#{r**\ 2595}# - (#{extend-var-env\ 369}# - #{l\ 2593}# - (list #{v\ 2591}#) - #{r*\ 2567}#))) + (let ((#{r**\ 2589}# + (#{extend-var-env\ 370}# + #{l\ 2587}# + (list #{v\ 2585}#) + #{r*\ 2561}#))) (begin - (let ((#{w**\ 2597}# - (#{make-binding-wrap\ 423}# - (list #{id\ 2587}#) - #{l\ 2593}# - #{w*\ 2568}#))) - (#{expand-opt\ 2538}# - #{req\ 2561}# - (cdr #{opt\ 2562}#) - #{rest\ 2563}# - #{kw\ 2564}# - #{body\ 2565}# - (cons #{v\ 2591}# - #{vars\ 2566}#) - #{r**\ 2595}# - #{w**\ 2597}# + (let ((#{w**\ 2591}# + (#{make-binding-wrap\ 424}# + (list #{id\ 2581}#) + #{l\ 2587}# + #{w*\ 2562}#))) + (#{expand-opt\ 2532}# + #{req\ 2555}# + (cdr #{opt\ 2556}#) + #{rest\ 2557}# + #{kw\ 2558}# + #{body\ 2559}# + (cons #{v\ 2585}# + #{vars\ 2560}#) + #{r**\ 2589}# + #{w**\ 2591}# (cons (syntax->datum - #{id\ 2587}#) - #{out\ 2569}#) - (cons (#{chi\ 461}# - #{i\ 2588}# - #{r*\ 2567}# - #{w*\ 2568}# - #{mod\ 2525}#) - #{inits\ 2570}#))))))))))) - #{tmp\ 2584}#) + #{id\ 2581}#) + #{out\ 2563}#) + (cons (#{chi\ 460}# + #{i\ 2582}# + #{r*\ 2561}# + #{w*\ 2562}# + #{mod\ 2519}#) + #{inits\ 2564}#))))))))))) + #{tmp\ 2578}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2583}#)))) - (if #{rest\ 2563}# + #{tmp\ 2577}#)))) + (if #{rest\ 2557}# (begin - (let ((#{v\ 2602}# - (#{gen-var\ 489}# #{rest\ 2563}#))) + (let ((#{v\ 2596}# + (#{gen-var\ 488}# #{rest\ 2557}#))) (begin - (let ((#{l\ 2604}# - (#{gen-labels\ 394}# - (list #{v\ 2602}#)))) + (let ((#{l\ 2598}# + (#{gen-labels\ 395}# + (list #{v\ 2596}#)))) (begin - (let ((#{r*\ 2606}# - (#{extend-var-env\ 369}# - #{l\ 2604}# - (list #{v\ 2602}#) - #{r*\ 2567}#))) + (let ((#{r*\ 2600}# + (#{extend-var-env\ 370}# + #{l\ 2598}# + (list #{v\ 2596}#) + #{r*\ 2561}#))) (begin - (let ((#{w*\ 2608}# - (#{make-binding-wrap\ 423}# - (list #{rest\ 2563}#) - #{l\ 2604}# - #{w*\ 2568}#))) - (#{expand-kw\ 2540}# - #{req\ 2561}# - (if (pair? #{out\ 2569}#) - (reverse #{out\ 2569}#) + (let ((#{w*\ 2602}# + (#{make-binding-wrap\ 424}# + (list #{rest\ 2557}#) + #{l\ 2598}# + #{w*\ 2562}#))) + (#{expand-kw\ 2534}# + #{req\ 2555}# + (if (pair? #{out\ 2563}#) + (reverse #{out\ 2563}#) #f) - (syntax->datum #{rest\ 2563}#) - (if (pair? #{kw\ 2564}#) - (cdr #{kw\ 2564}#) - #{kw\ 2564}#) - #{body\ 2565}# - (cons #{v\ 2602}# #{vars\ 2566}#) - #{r*\ 2606}# - #{w*\ 2608}# - (if (pair? #{kw\ 2564}#) - (car #{kw\ 2564}#) + (syntax->datum #{rest\ 2557}#) + (if (pair? #{kw\ 2558}#) + (cdr #{kw\ 2558}#) + #{kw\ 2558}#) + #{body\ 2559}# + (cons #{v\ 2596}# #{vars\ 2560}#) + #{r*\ 2600}# + #{w*\ 2602}# + (if (pair? #{kw\ 2558}#) + (car #{kw\ 2558}#) #f) '() - #{inits\ 2570}#))))))))) - (#{expand-kw\ 2540}# - #{req\ 2561}# - (if (pair? #{out\ 2569}#) - (reverse #{out\ 2569}#) + #{inits\ 2564}#))))))))) + (#{expand-kw\ 2534}# + #{req\ 2555}# + (if (pair? #{out\ 2563}#) + (reverse #{out\ 2563}#) #f) #f - (if (pair? #{kw\ 2564}#) - (cdr #{kw\ 2564}#) - #{kw\ 2564}#) - #{body\ 2565}# - #{vars\ 2566}# - #{r*\ 2567}# - #{w*\ 2568}# - (if (pair? #{kw\ 2564}#) (car #{kw\ 2564}#) #f) + (if (pair? #{kw\ 2558}#) + (cdr #{kw\ 2558}#) + #{kw\ 2558}#) + #{body\ 2559}# + #{vars\ 2560}# + #{r*\ 2561}# + #{w*\ 2562}# + (if (pair? #{kw\ 2558}#) (car #{kw\ 2558}#) #f) '() - #{inits\ 2570}#))))) - (#{expand-kw\ 2540}# - (lambda (#{req\ 2610}# - #{opt\ 2611}# - #{rest\ 2612}# - #{kw\ 2613}# - #{body\ 2614}# - #{vars\ 2615}# - #{r*\ 2616}# - #{w*\ 2617}# - #{aok\ 2618}# - #{out\ 2619}# - #{inits\ 2620}#) - (if (pair? #{kw\ 2613}#) - (let ((#{tmp\ 2634}# (car #{kw\ 2613}#))) - (let ((#{tmp\ 2635}# - ($sc-dispatch #{tmp\ 2634}# '(any any any)))) - (if #{tmp\ 2635}# + #{inits\ 2564}#))))) + (#{expand-kw\ 2534}# + (lambda (#{req\ 2604}# + #{opt\ 2605}# + #{rest\ 2606}# + #{kw\ 2607}# + #{body\ 2608}# + #{vars\ 2609}# + #{r*\ 2610}# + #{w*\ 2611}# + #{aok\ 2612}# + #{out\ 2613}# + #{inits\ 2614}#) + (if (pair? #{kw\ 2607}#) + (let ((#{tmp\ 2628}# (car #{kw\ 2607}#))) + (let ((#{tmp\ 2629}# + ($sc-dispatch #{tmp\ 2628}# '(any any any)))) + (if #{tmp\ 2629}# (@apply - (lambda (#{k\ 2639}# #{id\ 2640}# #{i\ 2641}#) + (lambda (#{k\ 2633}# #{id\ 2634}# #{i\ 2635}#) (begin - (let ((#{v\ 2644}# - (#{gen-var\ 489}# #{id\ 2640}#))) + (let ((#{v\ 2638}# + (#{gen-var\ 488}# #{id\ 2634}#))) (begin - (let ((#{l\ 2646}# - (#{gen-labels\ 394}# - (list #{v\ 2644}#)))) + (let ((#{l\ 2640}# + (#{gen-labels\ 395}# + (list #{v\ 2638}#)))) (begin - (let ((#{r**\ 2648}# - (#{extend-var-env\ 369}# - #{l\ 2646}# - (list #{v\ 2644}#) - #{r*\ 2616}#))) + (let ((#{r**\ 2642}# + (#{extend-var-env\ 370}# + #{l\ 2640}# + (list #{v\ 2638}#) + #{r*\ 2610}#))) (begin - (let ((#{w**\ 2650}# - (#{make-binding-wrap\ 423}# - (list #{id\ 2640}#) - #{l\ 2646}# - #{w*\ 2617}#))) - (#{expand-kw\ 2540}# - #{req\ 2610}# - #{opt\ 2611}# - #{rest\ 2612}# - (cdr #{kw\ 2613}#) - #{body\ 2614}# - (cons #{v\ 2644}# - #{vars\ 2615}#) - #{r**\ 2648}# - #{w**\ 2650}# - #{aok\ 2618}# + (let ((#{w**\ 2644}# + (#{make-binding-wrap\ 424}# + (list #{id\ 2634}#) + #{l\ 2640}# + #{w*\ 2611}#))) + (#{expand-kw\ 2534}# + #{req\ 2604}# + #{opt\ 2605}# + #{rest\ 2606}# + (cdr #{kw\ 2607}#) + #{body\ 2608}# + (cons #{v\ 2638}# + #{vars\ 2609}#) + #{r**\ 2642}# + #{w**\ 2644}# + #{aok\ 2612}# (cons (list (syntax->datum - #{k\ 2639}#) + #{k\ 2633}#) (syntax->datum - #{id\ 2640}#) - #{v\ 2644}#) - #{out\ 2619}#) - (cons (#{chi\ 461}# - #{i\ 2641}# - #{r*\ 2616}# - #{w*\ 2617}# - #{mod\ 2525}#) - #{inits\ 2620}#))))))))))) - #{tmp\ 2635}#) + #{id\ 2634}#) + #{v\ 2638}#) + #{out\ 2613}#) + (cons (#{chi\ 460}# + #{i\ 2635}# + #{r*\ 2610}# + #{w*\ 2611}# + #{mod\ 2519}#) + #{inits\ 2614}#))))))))))) + #{tmp\ 2629}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2634}#)))) - (#{expand-body\ 2542}# - #{req\ 2610}# - #{opt\ 2611}# - #{rest\ 2612}# + #{tmp\ 2628}#)))) + (#{expand-body\ 2536}# + #{req\ 2604}# + #{opt\ 2605}# + #{rest\ 2606}# (if (begin - (let ((#{t\ 2654}# #{aok\ 2618}#)) - (if #{t\ 2654}# - #{t\ 2654}# - (pair? #{out\ 2619}#)))) - (cons #{aok\ 2618}# (reverse #{out\ 2619}#)) + (let ((#{t\ 2648}# #{aok\ 2612}#)) + (if #{t\ 2648}# + #{t\ 2648}# + (pair? #{out\ 2613}#)))) + (cons #{aok\ 2612}# (reverse #{out\ 2613}#)) #f) - #{body\ 2614}# - (reverse #{vars\ 2615}#) - #{r*\ 2616}# - #{w*\ 2617}# - (reverse #{inits\ 2620}#) + #{body\ 2608}# + (reverse #{vars\ 2609}#) + #{r*\ 2610}# + #{w*\ 2611}# + (reverse #{inits\ 2614}#) '())))) - (#{expand-body\ 2542}# - (lambda (#{req\ 2656}# - #{opt\ 2657}# - #{rest\ 2658}# - #{kw\ 2659}# - #{body\ 2660}# - #{vars\ 2661}# - #{r*\ 2662}# - #{w*\ 2663}# - #{inits\ 2664}# - #{meta\ 2665}#) - (let ((#{tmp\ 2676}# #{body\ 2660}#)) - (let ((#{tmp\ 2677}# + (#{expand-body\ 2536}# + (lambda (#{req\ 2650}# + #{opt\ 2651}# + #{rest\ 2652}# + #{kw\ 2653}# + #{body\ 2654}# + #{vars\ 2655}# + #{r*\ 2656}# + #{w*\ 2657}# + #{inits\ 2658}# + #{meta\ 2659}#) + (let ((#{tmp\ 2670}# #{body\ 2654}#)) + (let ((#{tmp\ 2671}# ($sc-dispatch - #{tmp\ 2676}# + #{tmp\ 2670}# '(any any . each-any)))) - (if (if #{tmp\ 2677}# + (if (if #{tmp\ 2671}# (@apply - (lambda (#{docstring\ 2681}# - #{e1\ 2682}# - #{e2\ 2683}#) + (lambda (#{docstring\ 2675}# + #{e1\ 2676}# + #{e2\ 2677}#) (string? - (syntax->datum #{docstring\ 2681}#))) - #{tmp\ 2677}#) + (syntax->datum #{docstring\ 2675}#))) + #{tmp\ 2671}#) #f) (@apply - (lambda (#{docstring\ 2687}# - #{e1\ 2688}# - #{e2\ 2689}#) - (#{expand-body\ 2542}# - #{req\ 2656}# - #{opt\ 2657}# - #{rest\ 2658}# - #{kw\ 2659}# - (cons #{e1\ 2688}# #{e2\ 2689}#) - #{vars\ 2661}# - #{r*\ 2662}# - #{w*\ 2663}# - #{inits\ 2664}# + (lambda (#{docstring\ 2681}# + #{e1\ 2682}# + #{e2\ 2683}#) + (#{expand-body\ 2536}# + #{req\ 2650}# + #{opt\ 2651}# + #{rest\ 2652}# + #{kw\ 2653}# + (cons #{e1\ 2682}# #{e2\ 2683}#) + #{vars\ 2655}# + #{r*\ 2656}# + #{w*\ 2657}# + #{inits\ 2658}# (append - #{meta\ 2665}# + #{meta\ 2659}# (list (cons 'documentation (syntax->datum - #{docstring\ 2687}#)))))) - #{tmp\ 2677}#) - (let ((#{tmp\ 2692}# + #{docstring\ 2681}#)))))) + #{tmp\ 2671}#) + (let ((#{tmp\ 2686}# ($sc-dispatch - #{tmp\ 2676}# + #{tmp\ 2670}# '(#(vector #(each (any . any))) any . each-any)))) - (if #{tmp\ 2692}# + (if #{tmp\ 2686}# (@apply - (lambda (#{k\ 2697}# - #{v\ 2698}# - #{e1\ 2699}# - #{e2\ 2700}#) - (#{expand-body\ 2542}# - #{req\ 2656}# - #{opt\ 2657}# - #{rest\ 2658}# - #{kw\ 2659}# - (cons #{e1\ 2699}# #{e2\ 2700}#) - #{vars\ 2661}# - #{r*\ 2662}# - #{w*\ 2663}# - #{inits\ 2664}# + (lambda (#{k\ 2691}# + #{v\ 2692}# + #{e1\ 2693}# + #{e2\ 2694}#) + (#{expand-body\ 2536}# + #{req\ 2650}# + #{opt\ 2651}# + #{rest\ 2652}# + #{kw\ 2653}# + (cons #{e1\ 2693}# #{e2\ 2694}#) + #{vars\ 2655}# + #{r*\ 2656}# + #{w*\ 2657}# + #{inits\ 2658}# (append - #{meta\ 2665}# + #{meta\ 2659}# (syntax->datum - (map cons #{k\ 2697}# #{v\ 2698}#))))) - #{tmp\ 2692}#) - (let ((#{tmp\ 2704}# + (map cons #{k\ 2691}# #{v\ 2692}#))))) + #{tmp\ 2686}#) + (let ((#{tmp\ 2698}# ($sc-dispatch - #{tmp\ 2676}# + #{tmp\ 2670}# '(any . each-any)))) - (if #{tmp\ 2704}# + (if #{tmp\ 2698}# (@apply - (lambda (#{e1\ 2707}# #{e2\ 2708}#) + (lambda (#{e1\ 2701}# #{e2\ 2702}#) (values - #{meta\ 2665}# - #{req\ 2656}# - #{opt\ 2657}# - #{rest\ 2658}# - #{kw\ 2659}# - #{inits\ 2664}# - #{vars\ 2661}# - (#{chi-body\ 469}# - (cons #{e1\ 2707}# #{e2\ 2708}#) - (#{source-wrap\ 447}# - #{e\ 2521}# - #{w\ 2523}# - #{s\ 2524}# - #{mod\ 2525}#) - #{r*\ 2662}# - #{w*\ 2663}# - #{mod\ 2525}#))) - #{tmp\ 2704}#) + #{meta\ 2659}# + #{req\ 2650}# + #{opt\ 2651}# + #{rest\ 2652}# + #{kw\ 2653}# + #{inits\ 2658}# + #{vars\ 2655}# + (#{chi-body\ 468}# + (cons #{e1\ 2701}# #{e2\ 2702}#) + (#{source-wrap\ 448}# + #{e\ 2515}# + #{w\ 2517}# + #{s\ 2518}# + #{mod\ 2519}#) + #{r*\ 2656}# + #{w*\ 2657}# + #{mod\ 2519}#))) + #{tmp\ 2698}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2676}#))))))))))) + #{tmp\ 2670}#))))))))))) (begin - (let ((#{tmp\ 2710}# #{clauses\ 2527}#)) - (let ((#{tmp\ 2711}# ($sc-dispatch #{tmp\ 2710}# '()))) - (if #{tmp\ 2711}# + (let ((#{tmp\ 2704}# #{clauses\ 2521}#)) + (let ((#{tmp\ 2705}# ($sc-dispatch #{tmp\ 2704}# '()))) + (if #{tmp\ 2705}# (@apply (lambda () (values '() #f)) - #{tmp\ 2711}#) - (let ((#{tmp\ 2712}# + #{tmp\ 2705}#) + (let ((#{tmp\ 2706}# ($sc-dispatch - #{tmp\ 2710}# + #{tmp\ 2704}# '((any any . each-any) . #(each (any any . each-any)))))) - (if #{tmp\ 2712}# + (if #{tmp\ 2706}# (@apply - (lambda (#{args\ 2719}# - #{e1\ 2720}# - #{e2\ 2721}# - #{args*\ 2722}# - #{e1*\ 2723}# - #{e2*\ 2724}#) + (lambda (#{args\ 2713}# + #{e1\ 2714}# + #{e2\ 2715}# + #{args*\ 2716}# + #{e1*\ 2717}# + #{e2*\ 2718}#) (call-with-values (lambda () - (#{get-formals\ 2526}# #{args\ 2719}#)) - (lambda (#{req\ 2725}# - #{opt\ 2726}# - #{rest\ 2727}# - #{kw\ 2728}#) + (#{get-formals\ 2520}# #{args\ 2713}#)) + (lambda (#{req\ 2719}# + #{opt\ 2720}# + #{rest\ 2721}# + #{kw\ 2722}#) (call-with-values (lambda () - (#{expand-req\ 2536}# - #{req\ 2725}# - #{opt\ 2726}# - #{rest\ 2727}# - #{kw\ 2728}# - (cons #{e1\ 2720}# #{e2\ 2721}#))) - (lambda (#{meta\ 2734}# - #{req\ 2735}# - #{opt\ 2736}# - #{rest\ 2737}# - #{kw\ 2738}# - #{inits\ 2739}# - #{vars\ 2740}# - #{body\ 2741}#) + (#{expand-req\ 2530}# + #{req\ 2719}# + #{opt\ 2720}# + #{rest\ 2721}# + #{kw\ 2722}# + (cons #{e1\ 2714}# #{e2\ 2715}#))) + (lambda (#{meta\ 2728}# + #{req\ 2729}# + #{opt\ 2730}# + #{rest\ 2731}# + #{kw\ 2732}# + #{inits\ 2733}# + #{vars\ 2734}# + #{body\ 2735}#) (call-with-values (lambda () - (#{chi-lambda-case\ 485}# - #{e\ 2521}# - #{r\ 2522}# - #{w\ 2523}# - #{s\ 2524}# - #{mod\ 2525}# - #{get-formals\ 2526}# - (map (lambda (#{tmp\ 2752}# - #{tmp\ 2751}# - #{tmp\ 2750}#) - (cons #{tmp\ 2750}# - (cons #{tmp\ 2751}# - #{tmp\ 2752}#))) - #{e2*\ 2724}# - #{e1*\ 2723}# - #{args*\ 2722}#))) - (lambda (#{meta*\ 2754}# - #{else*\ 2755}#) + (#{chi-lambda-case\ 484}# + #{e\ 2515}# + #{r\ 2516}# + #{w\ 2517}# + #{s\ 2518}# + #{mod\ 2519}# + #{get-formals\ 2520}# + (map (lambda (#{tmp\ 2746}# + #{tmp\ 2745}# + #{tmp\ 2744}#) + (cons #{tmp\ 2744}# + (cons #{tmp\ 2745}# + #{tmp\ 2746}#))) + #{e2*\ 2718}# + #{e1*\ 2717}# + #{args*\ 2716}#))) + (lambda (#{meta*\ 2748}# + #{else*\ 2749}#) (values (append - #{meta\ 2734}# - #{meta*\ 2754}#) - (#{build-lambda-case\ 327}# - #{s\ 2524}# - #{req\ 2735}# - #{opt\ 2736}# - #{rest\ 2737}# - #{kw\ 2738}# - #{inits\ 2739}# - #{vars\ 2740}# - #{body\ 2741}# - #{else*\ 2755}#))))))))) - #{tmp\ 2712}#) + #{meta\ 2728}# + #{meta*\ 2748}#) + (#{build-lambda-case\ 328}# + #{s\ 2518}# + #{req\ 2729}# + #{opt\ 2730}# + #{rest\ 2731}# + #{kw\ 2732}# + #{inits\ 2733}# + #{vars\ 2734}# + #{body\ 2735}# + #{else*\ 2749}#))))))))) + #{tmp\ 2706}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2710}#)))))))))) - (#{strip\ 487}# - (lambda (#{x\ 2758}# #{w\ 2759}#) - (if (memq 'top (car #{w\ 2759}#)) - #{x\ 2758}# + #{tmp\ 2704}#)))))))))) + (#{strip\ 486}# + (lambda (#{x\ 2752}# #{w\ 2753}#) + (if (memq 'top (car #{w\ 2753}#)) + #{x\ 2752}# (letrec* - ((#{f\ 2766}# - (lambda (#{x\ 2767}#) - (if (#{syntax-object?\ 345}# #{x\ 2767}#) - (#{strip\ 487}# - (#{syntax-object-expression\ 347}# #{x\ 2767}#) - (#{syntax-object-wrap\ 349}# #{x\ 2767}#)) - (if (pair? #{x\ 2767}#) + ((#{f\ 2760}# + (lambda (#{x\ 2761}#) + (if (#{syntax-object?\ 346}# #{x\ 2761}#) + (#{strip\ 486}# + (#{syntax-object-expression\ 348}# #{x\ 2761}#) + (#{syntax-object-wrap\ 350}# #{x\ 2761}#)) + (if (pair? #{x\ 2761}#) (begin - (let ((#{a\ 2774}# (#{f\ 2766}# (car #{x\ 2767}#))) - (#{d\ 2775}# - (#{f\ 2766}# (cdr #{x\ 2767}#)))) - (if (if (eq? #{a\ 2774}# (car #{x\ 2767}#)) - (eq? #{d\ 2775}# (cdr #{x\ 2767}#)) + (let ((#{a\ 2768}# (#{f\ 2760}# (car #{x\ 2761}#))) + (#{d\ 2769}# + (#{f\ 2760}# (cdr #{x\ 2761}#)))) + (if (if (eq? #{a\ 2768}# (car #{x\ 2761}#)) + (eq? #{d\ 2769}# (cdr #{x\ 2761}#)) #f) - #{x\ 2767}# - (cons #{a\ 2774}# #{d\ 2775}#)))) - (if (vector? #{x\ 2767}#) + #{x\ 2761}# + (cons #{a\ 2768}# #{d\ 2769}#)))) + (if (vector? #{x\ 2761}#) (begin - (let ((#{old\ 2781}# (vector->list #{x\ 2767}#))) + (let ((#{old\ 2775}# (vector->list #{x\ 2761}#))) (begin - (let ((#{new\ 2783}# - (map #{f\ 2766}# #{old\ 2781}#))) - (if (#{and-map*\ 37}# + (let ((#{new\ 2777}# + (map #{f\ 2760}# #{old\ 2775}#))) + (if (#{and-map*\ 38}# eq? - #{old\ 2781}# - #{new\ 2783}#) - #{x\ 2767}# - (list->vector #{new\ 2783}#)))))) - #{x\ 2767}#)))))) - (begin (#{f\ 2766}# #{x\ 2758}#)))))) - (#{gen-var\ 489}# - (lambda (#{id\ 2785}#) + #{old\ 2775}# + #{new\ 2777}#) + #{x\ 2761}# + (list->vector #{new\ 2777}#)))))) + #{x\ 2761}#)))))) + (begin (#{f\ 2760}# #{x\ 2752}#)))))) + (#{gen-var\ 488}# + (lambda (#{id\ 2779}#) (begin - (let ((#{id\ 2788}# - (if (#{syntax-object?\ 345}# #{id\ 2785}#) - (#{syntax-object-expression\ 347}# #{id\ 2785}#) - #{id\ 2785}#))) + (let ((#{id\ 2782}# + (if (#{syntax-object?\ 346}# #{id\ 2779}#) + (#{syntax-object-expression\ 348}# #{id\ 2779}#) + #{id\ 2779}#))) (gensym - (string-append (symbol->string #{id\ 2788}#) " ")))))) - (#{lambda-var-list\ 491}# - (lambda (#{vars\ 2790}#) + (string-append (symbol->string #{id\ 2782}#) " ")))))) + (#{lambda-var-list\ 490}# + (lambda (#{vars\ 2784}#) (letrec* - ((#{lvl\ 2796}# - (lambda (#{vars\ 2797}# #{ls\ 2798}# #{w\ 2799}#) - (if (pair? #{vars\ 2797}#) - (#{lvl\ 2796}# - (cdr #{vars\ 2797}#) - (cons (#{wrap\ 445}# - (car #{vars\ 2797}#) - #{w\ 2799}# + ((#{lvl\ 2790}# + (lambda (#{vars\ 2791}# #{ls\ 2792}# #{w\ 2793}#) + (if (pair? #{vars\ 2791}#) + (#{lvl\ 2790}# + (cdr #{vars\ 2791}#) + (cons (#{wrap\ 446}# + (car #{vars\ 2791}#) + #{w\ 2793}# #f) - #{ls\ 2798}#) - #{w\ 2799}#) - (if (#{id?\ 379}# #{vars\ 2797}#) - (cons (#{wrap\ 445}# #{vars\ 2797}# #{w\ 2799}# #f) - #{ls\ 2798}#) - (if (null? #{vars\ 2797}#) - #{ls\ 2798}# - (if (#{syntax-object?\ 345}# #{vars\ 2797}#) - (#{lvl\ 2796}# - (#{syntax-object-expression\ 347}# - #{vars\ 2797}#) - #{ls\ 2798}# - (#{join-wraps\ 427}# - #{w\ 2799}# - (#{syntax-object-wrap\ 349}# #{vars\ 2797}#))) - (cons #{vars\ 2797}# #{ls\ 2798}#)))))))) - (begin (#{lvl\ 2796}# #{vars\ 2790}# '() '(()))))))) + #{ls\ 2792}#) + #{w\ 2793}#) + (if (#{id?\ 380}# #{vars\ 2791}#) + (cons (#{wrap\ 446}# #{vars\ 2791}# #{w\ 2793}# #f) + #{ls\ 2792}#) + (if (null? #{vars\ 2791}#) + #{ls\ 2792}# + (if (#{syntax-object?\ 346}# #{vars\ 2791}#) + (#{lvl\ 2790}# + (#{syntax-object-expression\ 348}# + #{vars\ 2791}#) + #{ls\ 2792}# + (#{join-wraps\ 428}# + #{w\ 2793}# + (#{syntax-object-wrap\ 350}# #{vars\ 2791}#))) + (cons #{vars\ 2791}# #{ls\ 2792}#)))))))) + (begin (#{lvl\ 2790}# #{vars\ 2784}# '() '(()))))))) (begin - (set! #{make-primitive-ref\ 243}# - (lambda (#{src\ 757}# #{name\ 758}#) + (set! #{make-primitive-ref\ 244}# + (lambda (#{src\ 756}# #{name\ 757}#) (make-struct/no-tail (vector-ref %expanded-vtables 2) - #{src\ 757}# - #{name\ 758}#))) - (set! #{fx+\ 282}# +) - (set! #{fx-\ 284}# -) - (set! #{fx=\ 286}# =) - (set! #{fx<\ 288}# <) - (set! #{set-syntax-object-expression!\ 353}# - (lambda (#{x\ 1135}# #{update\ 1136}#) - (vector-set! #{x\ 1135}# 1 #{update\ 1136}#))) - (set! #{set-syntax-object-wrap!\ 355}# - (lambda (#{x\ 1139}# #{update\ 1140}#) - (vector-set! #{x\ 1139}# 2 #{update\ 1140}#))) - (set! #{set-syntax-object-module!\ 357}# - (lambda (#{x\ 1143}# #{update\ 1144}#) - (vector-set! #{x\ 1143}# 3 #{update\ 1144}#))) - (set! #{ribcage?\ 399}# - (lambda (#{x\ 1224}#) - (if (vector? #{x\ 1224}#) - (if (= (vector-length #{x\ 1224}#) 4) - (eq? (vector-ref #{x\ 1224}# 0) 'ribcage) + #{src\ 756}# + #{name\ 757}#))) + (set! #{fx+\ 283}# +) + (set! #{fx-\ 285}# -) + (set! #{fx=\ 287}# =) + (set! #{fx<\ 289}# <) + (set! #{set-syntax-object-expression!\ 354}# + (lambda (#{x\ 1134}# #{update\ 1135}#) + (vector-set! #{x\ 1134}# 1 #{update\ 1135}#))) + (set! #{set-syntax-object-wrap!\ 356}# + (lambda (#{x\ 1138}# #{update\ 1139}#) + (vector-set! #{x\ 1138}# 2 #{update\ 1139}#))) + (set! #{set-syntax-object-module!\ 358}# + (lambda (#{x\ 1142}# #{update\ 1143}#) + (vector-set! #{x\ 1142}# 3 #{update\ 1143}#))) + (set! #{ribcage?\ 400}# + (lambda (#{x\ 1223}#) + (if (vector? #{x\ 1223}#) + (if (= (vector-length #{x\ 1223}#) 4) + (eq? (vector-ref #{x\ 1223}# 0) 'ribcage) #f) #f))) (begin - (#{global-extend\ 375}# + (#{global-extend\ 376}# 'local-syntax 'letrec-syntax #t) - (#{global-extend\ 375}# + (#{global-extend\ 376}# 'local-syntax 'let-syntax #f) - (#{global-extend\ 375}# + (#{global-extend\ 376}# 'core 'fluid-let-syntax - (lambda (#{e\ 2810}# - #{r\ 2811}# - #{w\ 2812}# - #{s\ 2813}# - #{mod\ 2814}#) - (let ((#{tmp\ 2820}# #{e\ 2810}#)) - (let ((#{tmp\ 2821}# + (lambda (#{e\ 2804}# + #{r\ 2805}# + #{w\ 2806}# + #{s\ 2807}# + #{mod\ 2808}#) + (let ((#{tmp\ 2814}# #{e\ 2804}#)) + (let ((#{tmp\ 2815}# ($sc-dispatch - #{tmp\ 2820}# + #{tmp\ 2814}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 2821}# + (if (if #{tmp\ 2815}# (@apply - (lambda (#{var\ 2826}# - #{val\ 2827}# - #{e1\ 2828}# - #{e2\ 2829}#) - (#{valid-bound-ids?\ 439}# #{var\ 2826}#)) - #{tmp\ 2821}#) + (lambda (#{var\ 2820}# + #{val\ 2821}# + #{e1\ 2822}# + #{e2\ 2823}#) + (#{valid-bound-ids?\ 440}# #{var\ 2820}#)) + #{tmp\ 2815}#) #f) (@apply - (lambda (#{var\ 2835}# - #{val\ 2836}# - #{e1\ 2837}# - #{e2\ 2838}#) + (lambda (#{var\ 2829}# + #{val\ 2830}# + #{e1\ 2831}# + #{e2\ 2832}#) (begin - (let ((#{names\ 2840}# - (map (lambda (#{x\ 2841}#) - (#{id-var-name\ 433}# - #{x\ 2841}# - #{w\ 2812}#)) - #{var\ 2835}#))) + (let ((#{names\ 2834}# + (map (lambda (#{x\ 2835}#) + (#{id-var-name\ 434}# + #{x\ 2835}# + #{w\ 2806}#)) + #{var\ 2829}#))) (begin (for-each - (lambda (#{id\ 2844}# #{n\ 2845}#) + (lambda (#{id\ 2838}# #{n\ 2839}#) (begin - (let ((#{atom-key\ 2850}# - (car (#{lookup\ 373}# - #{n\ 2845}# - #{r\ 2811}# - #{mod\ 2814}#)))) - (if (eqv? #{atom-key\ 2850}# + (let ((#{atom-key\ 2844}# + (car (#{lookup\ 374}# + #{n\ 2839}# + #{r\ 2805}# + #{mod\ 2808}#)))) + (if (eqv? #{atom-key\ 2844}# 'displaced-lexical) (syntax-violation 'fluid-let-syntax "identifier out of context" - #{e\ 2810}# - (#{source-wrap\ 447}# - #{id\ 2844}# - #{w\ 2812}# - #{s\ 2813}# - #{mod\ 2814}#)))))) - #{var\ 2835}# - #{names\ 2840}#) - (#{chi-body\ 469}# - (cons #{e1\ 2837}# #{e2\ 2838}#) - (#{source-wrap\ 447}# - #{e\ 2810}# - #{w\ 2812}# - #{s\ 2813}# - #{mod\ 2814}#) - (#{extend-env\ 367}# - #{names\ 2840}# + #{e\ 2804}# + (#{source-wrap\ 448}# + #{id\ 2838}# + #{w\ 2806}# + #{s\ 2807}# + #{mod\ 2808}#)))))) + #{var\ 2829}# + #{names\ 2834}#) + (#{chi-body\ 468}# + (cons #{e1\ 2831}# #{e2\ 2832}#) + (#{source-wrap\ 448}# + #{e\ 2804}# + #{w\ 2806}# + #{s\ 2807}# + #{mod\ 2808}#) + (#{extend-env\ 368}# + #{names\ 2834}# (begin - (let ((#{trans-r\ 2856}# - (#{macros-only-env\ 371}# - #{r\ 2811}#))) - (map (lambda (#{x\ 2857}#) + (let ((#{trans-r\ 2850}# + (#{macros-only-env\ 372}# + #{r\ 2805}#))) + (map (lambda (#{x\ 2851}#) (cons 'macro - (#{eval-local-transformer\ 473}# - (#{chi\ 461}# - #{x\ 2857}# - #{trans-r\ 2856}# - #{w\ 2812}# - #{mod\ 2814}#) - #{mod\ 2814}#))) - #{val\ 2836}#))) - #{r\ 2811}#) - #{w\ 2812}# - #{mod\ 2814}#))))) - #{tmp\ 2821}#) - (let ((#{_\ 2862}# #{tmp\ 2820}#)) + (#{eval-local-transformer\ 472}# + (#{chi\ 460}# + #{x\ 2851}# + #{trans-r\ 2850}# + #{w\ 2806}# + #{mod\ 2808}#) + #{mod\ 2808}#))) + #{val\ 2830}#))) + #{r\ 2805}#) + #{w\ 2806}# + #{mod\ 2808}#))))) + #{tmp\ 2815}#) + (let ((#{_\ 2856}# #{tmp\ 2814}#)) (syntax-violation 'fluid-let-syntax "bad syntax" - (#{source-wrap\ 447}# - #{e\ 2810}# - #{w\ 2812}# - #{s\ 2813}# - #{mod\ 2814}#)))))))) - (#{global-extend\ 375}# + (#{source-wrap\ 448}# + #{e\ 2804}# + #{w\ 2806}# + #{s\ 2807}# + #{mod\ 2808}#)))))))) + (#{global-extend\ 376}# 'core 'quote - (lambda (#{e\ 2863}# - #{r\ 2864}# - #{w\ 2865}# - #{s\ 2866}# - #{mod\ 2867}#) - (let ((#{tmp\ 2873}# #{e\ 2863}#)) - (let ((#{tmp\ 2874}# - ($sc-dispatch #{tmp\ 2873}# '(_ any)))) - (if #{tmp\ 2874}# + (lambda (#{e\ 2857}# + #{r\ 2858}# + #{w\ 2859}# + #{s\ 2860}# + #{mod\ 2861}#) + (let ((#{tmp\ 2867}# #{e\ 2857}#)) + (let ((#{tmp\ 2868}# + ($sc-dispatch #{tmp\ 2867}# '(_ any)))) + (if #{tmp\ 2868}# (@apply - (lambda (#{e\ 2876}#) - (#{build-data\ 331}# - #{s\ 2866}# - (#{strip\ 487}# #{e\ 2876}# #{w\ 2865}#))) - #{tmp\ 2874}#) - (let ((#{_\ 2878}# #{tmp\ 2873}#)) + (lambda (#{e\ 2870}#) + (#{build-data\ 332}# + #{s\ 2860}# + (#{strip\ 486}# #{e\ 2870}# #{w\ 2859}#))) + #{tmp\ 2868}#) + (let ((#{_\ 2872}# #{tmp\ 2867}#)) (syntax-violation 'quote "bad syntax" - (#{source-wrap\ 447}# - #{e\ 2863}# - #{w\ 2865}# - #{s\ 2866}# - #{mod\ 2867}#)))))))) - (#{global-extend\ 375}# + (#{source-wrap\ 448}# + #{e\ 2857}# + #{w\ 2859}# + #{s\ 2860}# + #{mod\ 2861}#)))))))) + (#{global-extend\ 376}# 'core 'syntax (letrec* - ((#{gen-syntax\ 2880}# - (lambda (#{src\ 2895}# - #{e\ 2896}# - #{r\ 2897}# - #{maps\ 2898}# - #{ellipsis?\ 2899}# - #{mod\ 2900}#) - (if (#{id?\ 379}# #{e\ 2896}#) + ((#{gen-syntax\ 2874}# + (lambda (#{src\ 2889}# + #{e\ 2890}# + #{r\ 2891}# + #{maps\ 2892}# + #{ellipsis?\ 2893}# + #{mod\ 2894}#) + (if (#{id?\ 380}# #{e\ 2890}#) (begin - (let ((#{label\ 2908}# - (#{id-var-name\ 433}# #{e\ 2896}# '(())))) + (let ((#{label\ 2902}# + (#{id-var-name\ 434}# #{e\ 2890}# '(())))) (begin - (let ((#{b\ 2911}# - (#{lookup\ 373}# - #{label\ 2908}# - #{r\ 2897}# - #{mod\ 2900}#))) - (if (eq? (car #{b\ 2911}#) 'syntax) + (let ((#{b\ 2905}# + (#{lookup\ 374}# + #{label\ 2902}# + #{r\ 2891}# + #{mod\ 2894}#))) + (if (eq? (car #{b\ 2905}#) 'syntax) (call-with-values (lambda () (begin - (let ((#{var.lev\ 2914}# - (cdr #{b\ 2911}#))) - (#{gen-ref\ 2882}# - #{src\ 2895}# - (car #{var.lev\ 2914}#) - (cdr #{var.lev\ 2914}#) - #{maps\ 2898}#)))) - (lambda (#{var\ 2916}# #{maps\ 2917}#) + (let ((#{var.lev\ 2908}# + (cdr #{b\ 2905}#))) + (#{gen-ref\ 2876}# + #{src\ 2889}# + (car #{var.lev\ 2908}#) + (cdr #{var.lev\ 2908}#) + #{maps\ 2892}#)))) + (lambda (#{var\ 2910}# #{maps\ 2911}#) (values - (list 'ref #{var\ 2916}#) - #{maps\ 2917}#))) - (if (#{ellipsis?\ 2899}# #{e\ 2896}#) + (list 'ref #{var\ 2910}#) + #{maps\ 2911}#))) + (if (#{ellipsis?\ 2893}# #{e\ 2890}#) (syntax-violation 'syntax "misplaced ellipsis" - #{src\ 2895}#) + #{src\ 2889}#) (values - (list 'quote #{e\ 2896}#) - #{maps\ 2898}#))))))) - (let ((#{tmp\ 2922}# #{e\ 2896}#)) - (let ((#{tmp\ 2923}# - ($sc-dispatch #{tmp\ 2922}# '(any any)))) - (if (if #{tmp\ 2923}# + (list 'quote #{e\ 2890}#) + #{maps\ 2892}#))))))) + (let ((#{tmp\ 2916}# #{e\ 2890}#)) + (let ((#{tmp\ 2917}# + ($sc-dispatch #{tmp\ 2916}# '(any any)))) + (if (if #{tmp\ 2917}# (@apply - (lambda (#{dots\ 2926}# #{e\ 2927}#) - (#{ellipsis?\ 2899}# #{dots\ 2926}#)) - #{tmp\ 2923}#) + (lambda (#{dots\ 2920}# #{e\ 2921}#) + (#{ellipsis?\ 2893}# #{dots\ 2920}#)) + #{tmp\ 2917}#) #f) (@apply - (lambda (#{dots\ 2930}# #{e\ 2931}#) - (#{gen-syntax\ 2880}# - #{src\ 2895}# - #{e\ 2931}# - #{r\ 2897}# - #{maps\ 2898}# - (lambda (#{x\ 2932}#) #f) - #{mod\ 2900}#)) - #{tmp\ 2923}#) - (let ((#{tmp\ 2934}# + (lambda (#{dots\ 2924}# #{e\ 2925}#) + (#{gen-syntax\ 2874}# + #{src\ 2889}# + #{e\ 2925}# + #{r\ 2891}# + #{maps\ 2892}# + (lambda (#{x\ 2926}#) #f) + #{mod\ 2894}#)) + #{tmp\ 2917}#) + (let ((#{tmp\ 2928}# ($sc-dispatch - #{tmp\ 2922}# + #{tmp\ 2916}# '(any any . any)))) - (if (if #{tmp\ 2934}# + (if (if #{tmp\ 2928}# (@apply - (lambda (#{x\ 2938}# - #{dots\ 2939}# - #{y\ 2940}#) - (#{ellipsis?\ 2899}# #{dots\ 2939}#)) - #{tmp\ 2934}#) + (lambda (#{x\ 2932}# + #{dots\ 2933}# + #{y\ 2934}#) + (#{ellipsis?\ 2893}# #{dots\ 2933}#)) + #{tmp\ 2928}#) #f) (@apply - (lambda (#{x\ 2944}# - #{dots\ 2945}# - #{y\ 2946}#) + (lambda (#{x\ 2938}# + #{dots\ 2939}# + #{y\ 2940}#) (letrec* - ((#{f\ 2950}# - (lambda (#{y\ 2951}# #{k\ 2952}#) - (let ((#{tmp\ 2959}# #{y\ 2951}#)) - (let ((#{tmp\ 2960}# + ((#{f\ 2944}# + (lambda (#{y\ 2945}# #{k\ 2946}#) + (let ((#{tmp\ 2953}# #{y\ 2945}#)) + (let ((#{tmp\ 2954}# ($sc-dispatch - #{tmp\ 2959}# + #{tmp\ 2953}# '(any . any)))) - (if (if #{tmp\ 2960}# + (if (if #{tmp\ 2954}# (@apply - (lambda (#{dots\ 2963}# - #{y\ 2964}#) - (#{ellipsis?\ 2899}# - #{dots\ 2963}#)) - #{tmp\ 2960}#) + (lambda (#{dots\ 2957}# + #{y\ 2958}#) + (#{ellipsis?\ 2893}# + #{dots\ 2957}#)) + #{tmp\ 2954}#) #f) (@apply - (lambda (#{dots\ 2967}# - #{y\ 2968}#) - (#{f\ 2950}# - #{y\ 2968}# - (lambda (#{maps\ 2969}#) + (lambda (#{dots\ 2961}# + #{y\ 2962}#) + (#{f\ 2944}# + #{y\ 2962}# + (lambda (#{maps\ 2963}#) (call-with-values (lambda () - (#{k\ 2952}# + (#{k\ 2946}# (cons '() - #{maps\ 2969}#))) - (lambda (#{x\ 2971}# - #{maps\ 2972}#) - (if (null? (car #{maps\ 2972}#)) + #{maps\ 2963}#))) + (lambda (#{x\ 2965}# + #{maps\ 2966}#) + (if (null? (car #{maps\ 2966}#)) (syntax-violation 'syntax "extra ellipsis" - #{src\ 2895}#) + #{src\ 2889}#) (values - (#{gen-mappend\ 2884}# - #{x\ 2971}# - (car #{maps\ 2972}#)) - (cdr #{maps\ 2972}#)))))))) - #{tmp\ 2960}#) - (let ((#{_\ 2976}# - #{tmp\ 2959}#)) + (#{gen-mappend\ 2878}# + #{x\ 2965}# + (car #{maps\ 2966}#)) + (cdr #{maps\ 2966}#)))))))) + #{tmp\ 2954}#) + (let ((#{_\ 2970}# + #{tmp\ 2953}#)) (call-with-values (lambda () - (#{gen-syntax\ 2880}# - #{src\ 2895}# - #{y\ 2951}# - #{r\ 2897}# - #{maps\ 2898}# - #{ellipsis?\ 2899}# - #{mod\ 2900}#)) - (lambda (#{y\ 2977}# - #{maps\ 2978}#) + (#{gen-syntax\ 2874}# + #{src\ 2889}# + #{y\ 2945}# + #{r\ 2891}# + #{maps\ 2892}# + #{ellipsis?\ 2893}# + #{mod\ 2894}#)) + (lambda (#{y\ 2971}# + #{maps\ 2972}#) (call-with-values (lambda () - (#{k\ 2952}# - #{maps\ 2978}#)) - (lambda (#{x\ 2981}# - #{maps\ 2982}#) + (#{k\ 2946}# + #{maps\ 2972}#)) + (lambda (#{x\ 2975}# + #{maps\ 2976}#) (values - (#{gen-append\ 2890}# - #{x\ 2981}# - #{y\ 2977}#) - #{maps\ 2982}#)))))))))))) + (#{gen-append\ 2884}# + #{x\ 2975}# + #{y\ 2971}#) + #{maps\ 2976}#)))))))))))) (begin - (#{f\ 2950}# - #{y\ 2946}# - (lambda (#{maps\ 2953}#) + (#{f\ 2944}# + #{y\ 2940}# + (lambda (#{maps\ 2947}#) (call-with-values (lambda () - (#{gen-syntax\ 2880}# - #{src\ 2895}# - #{x\ 2944}# - #{r\ 2897}# - (cons '() #{maps\ 2953}#) - #{ellipsis?\ 2899}# - #{mod\ 2900}#)) - (lambda (#{x\ 2955}# - #{maps\ 2956}#) - (if (null? (car #{maps\ 2956}#)) + (#{gen-syntax\ 2874}# + #{src\ 2889}# + #{x\ 2938}# + #{r\ 2891}# + (cons '() #{maps\ 2947}#) + #{ellipsis?\ 2893}# + #{mod\ 2894}#)) + (lambda (#{x\ 2949}# + #{maps\ 2950}#) + (if (null? (car #{maps\ 2950}#)) (syntax-violation 'syntax "extra ellipsis" - #{src\ 2895}#) + #{src\ 2889}#) (values - (#{gen-map\ 2886}# - #{x\ 2955}# - (car #{maps\ 2956}#)) - (cdr #{maps\ 2956}#)))))))))) - #{tmp\ 2934}#) - (let ((#{tmp\ 2985}# + (#{gen-map\ 2880}# + #{x\ 2949}# + (car #{maps\ 2950}#)) + (cdr #{maps\ 2950}#)))))))))) + #{tmp\ 2928}#) + (let ((#{tmp\ 2979}# ($sc-dispatch - #{tmp\ 2922}# + #{tmp\ 2916}# '(any . any)))) - (if #{tmp\ 2985}# + (if #{tmp\ 2979}# (@apply - (lambda (#{x\ 2988}# #{y\ 2989}#) + (lambda (#{x\ 2982}# #{y\ 2983}#) (call-with-values (lambda () - (#{gen-syntax\ 2880}# - #{src\ 2895}# - #{x\ 2988}# - #{r\ 2897}# - #{maps\ 2898}# - #{ellipsis?\ 2899}# - #{mod\ 2900}#)) - (lambda (#{x\ 2990}# #{maps\ 2991}#) + (#{gen-syntax\ 2874}# + #{src\ 2889}# + #{x\ 2982}# + #{r\ 2891}# + #{maps\ 2892}# + #{ellipsis?\ 2893}# + #{mod\ 2894}#)) + (lambda (#{x\ 2984}# #{maps\ 2985}#) (call-with-values (lambda () - (#{gen-syntax\ 2880}# - #{src\ 2895}# - #{y\ 2989}# - #{r\ 2897}# - #{maps\ 2991}# - #{ellipsis?\ 2899}# - #{mod\ 2900}#)) - (lambda (#{y\ 2994}# - #{maps\ 2995}#) + (#{gen-syntax\ 2874}# + #{src\ 2889}# + #{y\ 2983}# + #{r\ 2891}# + #{maps\ 2985}# + #{ellipsis?\ 2893}# + #{mod\ 2894}#)) + (lambda (#{y\ 2988}# + #{maps\ 2989}#) (values - (#{gen-cons\ 2888}# - #{x\ 2990}# - #{y\ 2994}#) - #{maps\ 2995}#)))))) - #{tmp\ 2985}#) - (let ((#{tmp\ 2998}# + (#{gen-cons\ 2882}# + #{x\ 2984}# + #{y\ 2988}#) + #{maps\ 2989}#)))))) + #{tmp\ 2979}#) + (let ((#{tmp\ 2992}# ($sc-dispatch - #{tmp\ 2922}# + #{tmp\ 2916}# '#(vector (any . each-any))))) - (if #{tmp\ 2998}# + (if #{tmp\ 2992}# (@apply - (lambda (#{e1\ 3001}# #{e2\ 3002}#) + (lambda (#{e1\ 2995}# #{e2\ 2996}#) (call-with-values (lambda () - (#{gen-syntax\ 2880}# - #{src\ 2895}# - (cons #{e1\ 3001}# - #{e2\ 3002}#) - #{r\ 2897}# - #{maps\ 2898}# - #{ellipsis?\ 2899}# - #{mod\ 2900}#)) - (lambda (#{e\ 3004}# - #{maps\ 3005}#) + (#{gen-syntax\ 2874}# + #{src\ 2889}# + (cons #{e1\ 2995}# + #{e2\ 2996}#) + #{r\ 2891}# + #{maps\ 2892}# + #{ellipsis?\ 2893}# + #{mod\ 2894}#)) + (lambda (#{e\ 2998}# + #{maps\ 2999}#) (values - (#{gen-vector\ 2892}# - #{e\ 3004}#) - #{maps\ 3005}#)))) - #{tmp\ 2998}#) - (let ((#{_\ 3009}# #{tmp\ 2922}#)) + (#{gen-vector\ 2886}# + #{e\ 2998}#) + #{maps\ 2999}#)))) + #{tmp\ 2992}#) + (let ((#{_\ 3003}# #{tmp\ 2916}#)) (values - (list 'quote #{e\ 2896}#) - #{maps\ 2898}#)))))))))))))) - (#{gen-ref\ 2882}# - (lambda (#{src\ 3011}# - #{var\ 3012}# - #{level\ 3013}# - #{maps\ 3014}#) - (if (#{fx=\ 286}# #{level\ 3013}# 0) - (values #{var\ 3012}# #{maps\ 3014}#) - (if (null? #{maps\ 3014}#) + (list 'quote #{e\ 2890}#) + #{maps\ 2892}#)))))))))))))) + (#{gen-ref\ 2876}# + (lambda (#{src\ 3005}# + #{var\ 3006}# + #{level\ 3007}# + #{maps\ 3008}#) + (if (#{fx=\ 287}# #{level\ 3007}# 0) + (values #{var\ 3006}# #{maps\ 3008}#) + (if (null? #{maps\ 3008}#) (syntax-violation 'syntax "missing ellipsis" - #{src\ 3011}#) + #{src\ 3005}#) (call-with-values (lambda () - (#{gen-ref\ 2882}# - #{src\ 3011}# - #{var\ 3012}# - (#{fx-\ 284}# #{level\ 3013}# 1) - (cdr #{maps\ 3014}#))) - (lambda (#{outer-var\ 3019}# #{outer-maps\ 3020}#) + (#{gen-ref\ 2876}# + #{src\ 3005}# + #{var\ 3006}# + (#{fx-\ 285}# #{level\ 3007}# 1) + (cdr #{maps\ 3008}#))) + (lambda (#{outer-var\ 3013}# #{outer-maps\ 3014}#) (begin - (let ((#{b\ 3024}# - (assq #{outer-var\ 3019}# - (car #{maps\ 3014}#)))) - (if #{b\ 3024}# - (values (cdr #{b\ 3024}#) #{maps\ 3014}#) + (let ((#{b\ 3018}# + (assq #{outer-var\ 3013}# + (car #{maps\ 3008}#)))) + (if #{b\ 3018}# + (values (cdr #{b\ 3018}#) #{maps\ 3008}#) (begin - (let ((#{inner-var\ 3026}# - (#{gen-var\ 489}# 'tmp))) + (let ((#{inner-var\ 3020}# + (#{gen-var\ 488}# 'tmp))) (values - #{inner-var\ 3026}# - (cons (cons (cons #{outer-var\ 3019}# - #{inner-var\ 3026}#) - (car #{maps\ 3014}#)) - #{outer-maps\ 3020}#))))))))))))) - (#{gen-mappend\ 2884}# - (lambda (#{e\ 3027}# #{map-env\ 3028}#) + #{inner-var\ 3020}# + (cons (cons (cons #{outer-var\ 3013}# + #{inner-var\ 3020}#) + (car #{maps\ 3008}#)) + #{outer-maps\ 3014}#))))))))))))) + (#{gen-mappend\ 2878}# + (lambda (#{e\ 3021}# #{map-env\ 3022}#) (list 'apply '(primitive append) - (#{gen-map\ 2886}# #{e\ 3027}# #{map-env\ 3028}#)))) - (#{gen-map\ 2886}# - (lambda (#{e\ 3032}# #{map-env\ 3033}#) + (#{gen-map\ 2880}# #{e\ 3021}# #{map-env\ 3022}#)))) + (#{gen-map\ 2880}# + (lambda (#{e\ 3026}# #{map-env\ 3027}#) (begin - (let ((#{formals\ 3038}# (map cdr #{map-env\ 3033}#)) - (#{actuals\ 3039}# - (map (lambda (#{x\ 3040}#) - (list 'ref (car #{x\ 3040}#))) - #{map-env\ 3033}#))) - (if (eq? (car #{e\ 3032}#) 'ref) - (car #{actuals\ 3039}#) + (let ((#{formals\ 3032}# (map cdr #{map-env\ 3027}#)) + (#{actuals\ 3033}# + (map (lambda (#{x\ 3034}#) + (list 'ref (car #{x\ 3034}#))) + #{map-env\ 3027}#))) + (if (eq? (car #{e\ 3026}#) 'ref) + (car #{actuals\ 3033}#) (if (and-map - (lambda (#{x\ 3047}#) - (if (eq? (car #{x\ 3047}#) 'ref) - (memq (car (cdr #{x\ 3047}#)) - #{formals\ 3038}#) + (lambda (#{x\ 3041}#) + (if (eq? (car #{x\ 3041}#) 'ref) + (memq (car (cdr #{x\ 3041}#)) + #{formals\ 3032}#) #f)) - (cdr #{e\ 3032}#)) + (cdr #{e\ 3026}#)) (cons 'map - (cons (list 'primitive (car #{e\ 3032}#)) + (cons (list 'primitive (car #{e\ 3026}#)) (map (begin - (let ((#{r\ 3053}# + (let ((#{r\ 3047}# (map cons - #{formals\ 3038}# - #{actuals\ 3039}#))) - (lambda (#{x\ 3054}#) - (cdr (assq (car (cdr #{x\ 3054}#)) - #{r\ 3053}#))))) - (cdr #{e\ 3032}#)))) + #{formals\ 3032}# + #{actuals\ 3033}#))) + (lambda (#{x\ 3048}#) + (cdr (assq (car (cdr #{x\ 3048}#)) + #{r\ 3047}#))))) + (cdr #{e\ 3026}#)))) (cons 'map (cons (list 'lambda - #{formals\ 3038}# - #{e\ 3032}#) - #{actuals\ 3039}#)))))))) - (#{gen-cons\ 2888}# - (lambda (#{x\ 3058}# #{y\ 3059}#) + #{formals\ 3032}# + #{e\ 3026}#) + #{actuals\ 3033}#)))))))) + (#{gen-cons\ 2882}# + (lambda (#{x\ 3052}# #{y\ 3053}#) (begin - (let ((#{atom-key\ 3064}# (car #{y\ 3059}#))) - (if (eqv? #{atom-key\ 3064}# 'quote) - (if (eq? (car #{x\ 3058}#) 'quote) + (let ((#{atom-key\ 3058}# (car #{y\ 3053}#))) + (if (eqv? #{atom-key\ 3058}# 'quote) + (if (eq? (car #{x\ 3052}#) 'quote) (list 'quote - (cons (car (cdr #{x\ 3058}#)) - (car (cdr #{y\ 3059}#)))) - (if (eq? (car (cdr #{y\ 3059}#)) '()) - (list 'list #{x\ 3058}#) - (list 'cons #{x\ 3058}# #{y\ 3059}#))) - (if (eqv? #{atom-key\ 3064}# 'list) - (cons 'list (cons #{x\ 3058}# (cdr #{y\ 3059}#))) - (list 'cons #{x\ 3058}# #{y\ 3059}#))))))) - (#{gen-append\ 2890}# - (lambda (#{x\ 3073}# #{y\ 3074}#) - (if (equal? #{y\ 3074}# ''()) - #{x\ 3073}# - (list 'append #{x\ 3073}# #{y\ 3074}#)))) - (#{gen-vector\ 2892}# - (lambda (#{x\ 3078}#) - (if (eq? (car #{x\ 3078}#) 'list) - (cons 'vector (cdr #{x\ 3078}#)) - (if (eq? (car #{x\ 3078}#) 'quote) + (cons (car (cdr #{x\ 3052}#)) + (car (cdr #{y\ 3053}#)))) + (if (eq? (car (cdr #{y\ 3053}#)) '()) + (list 'list #{x\ 3052}#) + (list 'cons #{x\ 3052}# #{y\ 3053}#))) + (if (eqv? #{atom-key\ 3058}# 'list) + (cons 'list (cons #{x\ 3052}# (cdr #{y\ 3053}#))) + (list 'cons #{x\ 3052}# #{y\ 3053}#))))))) + (#{gen-append\ 2884}# + (lambda (#{x\ 3067}# #{y\ 3068}#) + (if (equal? #{y\ 3068}# ''()) + #{x\ 3067}# + (list 'append #{x\ 3067}# #{y\ 3068}#)))) + (#{gen-vector\ 2886}# + (lambda (#{x\ 3072}#) + (if (eq? (car #{x\ 3072}#) 'list) + (cons 'vector (cdr #{x\ 3072}#)) + (if (eq? (car #{x\ 3072}#) 'quote) (list 'quote - (list->vector (car (cdr #{x\ 3078}#)))) - (list 'list->vector #{x\ 3078}#))))) - (#{regen\ 2894}# - (lambda (#{x\ 3088}#) + (list->vector (car (cdr #{x\ 3072}#)))) + (list 'list->vector #{x\ 3072}#))))) + (#{regen\ 2888}# + (lambda (#{x\ 3082}#) (begin - (let ((#{atom-key\ 3092}# (car #{x\ 3088}#))) - (if (eqv? #{atom-key\ 3092}# 'ref) - (#{build-lexical-reference\ 311}# + (let ((#{atom-key\ 3086}# (car #{x\ 3082}#))) + (if (eqv? #{atom-key\ 3086}# 'ref) + (#{build-lexical-reference\ 312}# 'value #f - (car (cdr #{x\ 3088}#)) - (car (cdr #{x\ 3088}#))) - (if (eqv? #{atom-key\ 3092}# 'primitive) - (#{build-primref\ 329}# + (car (cdr #{x\ 3082}#)) + (car (cdr #{x\ 3082}#))) + (if (eqv? #{atom-key\ 3086}# 'primitive) + (#{build-primref\ 330}# #f - (car (cdr #{x\ 3088}#))) - (if (eqv? #{atom-key\ 3092}# 'quote) - (#{build-data\ 331}# #f (car (cdr #{x\ 3088}#))) - (if (eqv? #{atom-key\ 3092}# 'lambda) - (if (list? (car (cdr #{x\ 3088}#))) - (#{build-simple-lambda\ 323}# + (car (cdr #{x\ 3082}#))) + (if (eqv? #{atom-key\ 3086}# 'quote) + (#{build-data\ 332}# #f (car (cdr #{x\ 3082}#))) + (if (eqv? #{atom-key\ 3086}# 'lambda) + (if (list? (car (cdr #{x\ 3082}#))) + (#{build-simple-lambda\ 324}# #f - (car (cdr #{x\ 3088}#)) + (car (cdr #{x\ 3082}#)) #f - (car (cdr #{x\ 3088}#)) + (car (cdr #{x\ 3082}#)) '() - (#{regen\ 2894}# - (car (cdr (cdr #{x\ 3088}#))))) - (error "how did we get here" #{x\ 3088}#)) - (#{build-application\ 305}# + (#{regen\ 2888}# + (car (cdr (cdr #{x\ 3082}#))))) + (error "how did we get here" #{x\ 3082}#)) + (#{build-application\ 306}# #f - (#{build-primref\ 329}# + (#{build-primref\ 330}# #f - (car #{x\ 3088}#)) - (map #{regen\ 2894}# - (cdr #{x\ 3088}#)))))))))))) + (car #{x\ 3082}#)) + (map #{regen\ 2888}# + (cdr #{x\ 3082}#)))))))))))) (begin - (lambda (#{e\ 3104}# - #{r\ 3105}# - #{w\ 3106}# - #{s\ 3107}# - #{mod\ 3108}#) + (lambda (#{e\ 3098}# + #{r\ 3099}# + #{w\ 3100}# + #{s\ 3101}# + #{mod\ 3102}#) (begin - (let ((#{e\ 3115}# - (#{source-wrap\ 447}# - #{e\ 3104}# - #{w\ 3106}# - #{s\ 3107}# - #{mod\ 3108}#))) - (let ((#{tmp\ 3116}# #{e\ 3115}#)) - (let ((#{tmp\ 3117}# - ($sc-dispatch #{tmp\ 3116}# '(_ any)))) - (if #{tmp\ 3117}# + (let ((#{e\ 3109}# + (#{source-wrap\ 448}# + #{e\ 3098}# + #{w\ 3100}# + #{s\ 3101}# + #{mod\ 3102}#))) + (let ((#{tmp\ 3110}# #{e\ 3109}#)) + (let ((#{tmp\ 3111}# + ($sc-dispatch #{tmp\ 3110}# '(_ any)))) + (if #{tmp\ 3111}# (@apply - (lambda (#{x\ 3119}#) + (lambda (#{x\ 3113}#) (call-with-values (lambda () - (#{gen-syntax\ 2880}# - #{e\ 3115}# - #{x\ 3119}# - #{r\ 3105}# + (#{gen-syntax\ 2874}# + #{e\ 3109}# + #{x\ 3113}# + #{r\ 3099}# '() - #{ellipsis?\ 477}# - #{mod\ 3108}#)) - (lambda (#{e\ 3120}# #{maps\ 3121}#) - (#{regen\ 2894}# #{e\ 3120}#)))) - #{tmp\ 3117}#) - (let ((#{_\ 3125}# #{tmp\ 3116}#)) + #{ellipsis?\ 476}# + #{mod\ 3102}#)) + (lambda (#{e\ 3114}# #{maps\ 3115}#) + (#{regen\ 2888}# #{e\ 3114}#)))) + #{tmp\ 3111}#) + (let ((#{_\ 3119}# #{tmp\ 3110}#)) (syntax-violation 'syntax "bad `syntax' form" - #{e\ 3115}#))))))))))) - (#{global-extend\ 375}# + #{e\ 3109}#))))))))))) + (#{global-extend\ 376}# 'core 'lambda - (lambda (#{e\ 3126}# - #{r\ 3127}# - #{w\ 3128}# - #{s\ 3129}# - #{mod\ 3130}#) - (let ((#{tmp\ 3136}# #{e\ 3126}#)) - (let ((#{tmp\ 3137}# + (lambda (#{e\ 3120}# + #{r\ 3121}# + #{w\ 3122}# + #{s\ 3123}# + #{mod\ 3124}#) + (let ((#{tmp\ 3130}# #{e\ 3120}#)) + (let ((#{tmp\ 3131}# ($sc-dispatch - #{tmp\ 3136}# + #{tmp\ 3130}# '(_ any any . each-any)))) - (if #{tmp\ 3137}# + (if #{tmp\ 3131}# (@apply - (lambda (#{args\ 3141}# #{e1\ 3142}# #{e2\ 3143}#) + (lambda (#{args\ 3135}# #{e1\ 3136}# #{e2\ 3137}#) (call-with-values (lambda () - (#{lambda-formals\ 479}# #{args\ 3141}#)) - (lambda (#{req\ 3144}# - #{opt\ 3145}# - #{rest\ 3146}# - #{kw\ 3147}#) + (#{lambda-formals\ 478}# #{args\ 3135}#)) + (lambda (#{req\ 3138}# + #{opt\ 3139}# + #{rest\ 3140}# + #{kw\ 3141}#) (letrec* - ((#{lp\ 3155}# - (lambda (#{body\ 3156}# #{meta\ 3157}#) - (let ((#{tmp\ 3159}# #{body\ 3156}#)) - (let ((#{tmp\ 3160}# + ((#{lp\ 3149}# + (lambda (#{body\ 3150}# #{meta\ 3151}#) + (let ((#{tmp\ 3153}# #{body\ 3150}#)) + (let ((#{tmp\ 3154}# ($sc-dispatch - #{tmp\ 3159}# + #{tmp\ 3153}# '(any any . each-any)))) - (if (if #{tmp\ 3160}# + (if (if #{tmp\ 3154}# (@apply - (lambda (#{docstring\ 3164}# - #{e1\ 3165}# - #{e2\ 3166}#) + (lambda (#{docstring\ 3158}# + #{e1\ 3159}# + #{e2\ 3160}#) (string? (syntax->datum - #{docstring\ 3164}#))) - #{tmp\ 3160}#) + #{docstring\ 3158}#))) + #{tmp\ 3154}#) #f) (@apply - (lambda (#{docstring\ 3170}# - #{e1\ 3171}# - #{e2\ 3172}#) - (#{lp\ 3155}# - (cons #{e1\ 3171}# - #{e2\ 3172}#) + (lambda (#{docstring\ 3164}# + #{e1\ 3165}# + #{e2\ 3166}#) + (#{lp\ 3149}# + (cons #{e1\ 3165}# + #{e2\ 3166}#) (append - #{meta\ 3157}# + #{meta\ 3151}# (list (cons 'documentation (syntax->datum - #{docstring\ 3170}#)))))) - #{tmp\ 3160}#) - (let ((#{tmp\ 3175}# + #{docstring\ 3164}#)))))) + #{tmp\ 3154}#) + (let ((#{tmp\ 3169}# ($sc-dispatch - #{tmp\ 3159}# + #{tmp\ 3153}# '(#(vector #(each (any . any))) any . each-any)))) - (if #{tmp\ 3175}# + (if #{tmp\ 3169}# (@apply - (lambda (#{k\ 3180}# - #{v\ 3181}# - #{e1\ 3182}# - #{e2\ 3183}#) - (#{lp\ 3155}# - (cons #{e1\ 3182}# - #{e2\ 3183}#) + (lambda (#{k\ 3174}# + #{v\ 3175}# + #{e1\ 3176}# + #{e2\ 3177}#) + (#{lp\ 3149}# + (cons #{e1\ 3176}# + #{e2\ 3177}#) (append - #{meta\ 3157}# + #{meta\ 3151}# (syntax->datum (map cons - #{k\ 3180}# - #{v\ 3181}#))))) - #{tmp\ 3175}#) - (let ((#{_\ 3188}# - #{tmp\ 3159}#)) - (#{chi-simple-lambda\ 481}# - #{e\ 3126}# - #{r\ 3127}# - #{w\ 3128}# - #{s\ 3129}# - #{mod\ 3130}# - #{req\ 3144}# - #{rest\ 3146}# - #{meta\ 3157}# - #{body\ 3156}#)))))))))) + #{k\ 3174}# + #{v\ 3175}#))))) + #{tmp\ 3169}#) + (let ((#{_\ 3182}# + #{tmp\ 3153}#)) + (#{chi-simple-lambda\ 480}# + #{e\ 3120}# + #{r\ 3121}# + #{w\ 3122}# + #{s\ 3123}# + #{mod\ 3124}# + #{req\ 3138}# + #{rest\ 3140}# + #{meta\ 3151}# + #{body\ 3150}#)))))))))) (begin - (#{lp\ 3155}# - (cons #{e1\ 3142}# #{e2\ 3143}#) + (#{lp\ 3149}# + (cons #{e1\ 3136}# #{e2\ 3137}#) '())))))) - #{tmp\ 3137}#) - (let ((#{_\ 3190}# #{tmp\ 3136}#)) + #{tmp\ 3131}#) + (let ((#{_\ 3184}# #{tmp\ 3130}#)) (syntax-violation 'lambda "bad lambda" - #{e\ 3126}#))))))) - (#{global-extend\ 375}# + #{e\ 3120}#))))))) + (#{global-extend\ 376}# 'core 'lambda* - (lambda (#{e\ 3191}# - #{r\ 3192}# - #{w\ 3193}# - #{s\ 3194}# - #{mod\ 3195}#) - (let ((#{tmp\ 3201}# #{e\ 3191}#)) - (let ((#{tmp\ 3202}# + (lambda (#{e\ 3185}# + #{r\ 3186}# + #{w\ 3187}# + #{s\ 3188}# + #{mod\ 3189}#) + (let ((#{tmp\ 3195}# #{e\ 3185}#)) + (let ((#{tmp\ 3196}# ($sc-dispatch - #{tmp\ 3201}# + #{tmp\ 3195}# '(_ any any . each-any)))) - (if #{tmp\ 3202}# + (if #{tmp\ 3196}# (@apply - (lambda (#{args\ 3206}# #{e1\ 3207}# #{e2\ 3208}#) + (lambda (#{args\ 3200}# #{e1\ 3201}# #{e2\ 3202}#) (call-with-values (lambda () - (#{chi-lambda-case\ 485}# - #{e\ 3191}# - #{r\ 3192}# - #{w\ 3193}# - #{s\ 3194}# - #{mod\ 3195}# - #{lambda*-formals\ 483}# - (list (cons #{args\ 3206}# - (cons #{e1\ 3207}# - #{e2\ 3208}#))))) - (lambda (#{meta\ 3210}# #{lcase\ 3211}#) - (#{build-case-lambda\ 325}# - #{s\ 3194}# - #{meta\ 3210}# - #{lcase\ 3211}#)))) - #{tmp\ 3202}#) - (let ((#{_\ 3215}# #{tmp\ 3201}#)) + (#{chi-lambda-case\ 484}# + #{e\ 3185}# + #{r\ 3186}# + #{w\ 3187}# + #{s\ 3188}# + #{mod\ 3189}# + #{lambda*-formals\ 482}# + (list (cons #{args\ 3200}# + (cons #{e1\ 3201}# + #{e2\ 3202}#))))) + (lambda (#{meta\ 3204}# #{lcase\ 3205}#) + (#{build-case-lambda\ 326}# + #{s\ 3188}# + #{meta\ 3204}# + #{lcase\ 3205}#)))) + #{tmp\ 3196}#) + (let ((#{_\ 3209}# #{tmp\ 3195}#)) (syntax-violation 'lambda "bad lambda*" - #{e\ 3191}#))))))) - (#{global-extend\ 375}# + #{e\ 3185}#))))))) + (#{global-extend\ 376}# 'core 'case-lambda - (lambda (#{e\ 3216}# - #{r\ 3217}# - #{w\ 3218}# - #{s\ 3219}# - #{mod\ 3220}#) - (let ((#{tmp\ 3226}# #{e\ 3216}#)) - (let ((#{tmp\ 3227}# + (lambda (#{e\ 3210}# + #{r\ 3211}# + #{w\ 3212}# + #{s\ 3213}# + #{mod\ 3214}#) + (let ((#{tmp\ 3220}# #{e\ 3210}#)) + (let ((#{tmp\ 3221}# ($sc-dispatch - #{tmp\ 3226}# + #{tmp\ 3220}# '(_ (any any . each-any) . #(each (any any . each-any)))))) - (if #{tmp\ 3227}# + (if #{tmp\ 3221}# (@apply - (lambda (#{args\ 3234}# - #{e1\ 3235}# - #{e2\ 3236}# - #{args*\ 3237}# - #{e1*\ 3238}# - #{e2*\ 3239}#) + (lambda (#{args\ 3228}# + #{e1\ 3229}# + #{e2\ 3230}# + #{args*\ 3231}# + #{e1*\ 3232}# + #{e2*\ 3233}#) (call-with-values (lambda () - (#{chi-lambda-case\ 485}# - #{e\ 3216}# - #{r\ 3217}# - #{w\ 3218}# - #{s\ 3219}# - #{mod\ 3220}# - #{lambda-formals\ 479}# - (cons (cons #{args\ 3234}# - (cons #{e1\ 3235}# #{e2\ 3236}#)) - (map (lambda (#{tmp\ 3243}# - #{tmp\ 3242}# - #{tmp\ 3241}#) - (cons #{tmp\ 3241}# - (cons #{tmp\ 3242}# - #{tmp\ 3243}#))) - #{e2*\ 3239}# - #{e1*\ 3238}# - #{args*\ 3237}#)))) - (lambda (#{meta\ 3245}# #{lcase\ 3246}#) - (#{build-case-lambda\ 325}# - #{s\ 3219}# - #{meta\ 3245}# - #{lcase\ 3246}#)))) - #{tmp\ 3227}#) - (let ((#{_\ 3250}# #{tmp\ 3226}#)) + (#{chi-lambda-case\ 484}# + #{e\ 3210}# + #{r\ 3211}# + #{w\ 3212}# + #{s\ 3213}# + #{mod\ 3214}# + #{lambda-formals\ 478}# + (cons (cons #{args\ 3228}# + (cons #{e1\ 3229}# #{e2\ 3230}#)) + (map (lambda (#{tmp\ 3237}# + #{tmp\ 3236}# + #{tmp\ 3235}#) + (cons #{tmp\ 3235}# + (cons #{tmp\ 3236}# + #{tmp\ 3237}#))) + #{e2*\ 3233}# + #{e1*\ 3232}# + #{args*\ 3231}#)))) + (lambda (#{meta\ 3239}# #{lcase\ 3240}#) + (#{build-case-lambda\ 326}# + #{s\ 3213}# + #{meta\ 3239}# + #{lcase\ 3240}#)))) + #{tmp\ 3221}#) + (let ((#{_\ 3244}# #{tmp\ 3220}#)) (syntax-violation 'case-lambda "bad case-lambda" - #{e\ 3216}#))))))) - (#{global-extend\ 375}# + #{e\ 3210}#))))))) + (#{global-extend\ 376}# 'core 'case-lambda* - (lambda (#{e\ 3251}# - #{r\ 3252}# - #{w\ 3253}# - #{s\ 3254}# - #{mod\ 3255}#) - (let ((#{tmp\ 3261}# #{e\ 3251}#)) - (let ((#{tmp\ 3262}# + (lambda (#{e\ 3245}# + #{r\ 3246}# + #{w\ 3247}# + #{s\ 3248}# + #{mod\ 3249}#) + (let ((#{tmp\ 3255}# #{e\ 3245}#)) + (let ((#{tmp\ 3256}# ($sc-dispatch - #{tmp\ 3261}# + #{tmp\ 3255}# '(_ (any any . each-any) . #(each (any any . each-any)))))) - (if #{tmp\ 3262}# + (if #{tmp\ 3256}# (@apply - (lambda (#{args\ 3269}# - #{e1\ 3270}# - #{e2\ 3271}# - #{args*\ 3272}# - #{e1*\ 3273}# - #{e2*\ 3274}#) + (lambda (#{args\ 3263}# + #{e1\ 3264}# + #{e2\ 3265}# + #{args*\ 3266}# + #{e1*\ 3267}# + #{e2*\ 3268}#) (call-with-values (lambda () - (#{chi-lambda-case\ 485}# - #{e\ 3251}# - #{r\ 3252}# - #{w\ 3253}# - #{s\ 3254}# - #{mod\ 3255}# - #{lambda*-formals\ 483}# - (cons (cons #{args\ 3269}# - (cons #{e1\ 3270}# #{e2\ 3271}#)) - (map (lambda (#{tmp\ 3278}# - #{tmp\ 3277}# - #{tmp\ 3276}#) - (cons #{tmp\ 3276}# - (cons #{tmp\ 3277}# - #{tmp\ 3278}#))) - #{e2*\ 3274}# - #{e1*\ 3273}# - #{args*\ 3272}#)))) - (lambda (#{meta\ 3280}# #{lcase\ 3281}#) - (#{build-case-lambda\ 325}# - #{s\ 3254}# - #{meta\ 3280}# - #{lcase\ 3281}#)))) - #{tmp\ 3262}#) - (let ((#{_\ 3285}# #{tmp\ 3261}#)) + (#{chi-lambda-case\ 484}# + #{e\ 3245}# + #{r\ 3246}# + #{w\ 3247}# + #{s\ 3248}# + #{mod\ 3249}# + #{lambda*-formals\ 482}# + (cons (cons #{args\ 3263}# + (cons #{e1\ 3264}# #{e2\ 3265}#)) + (map (lambda (#{tmp\ 3272}# + #{tmp\ 3271}# + #{tmp\ 3270}#) + (cons #{tmp\ 3270}# + (cons #{tmp\ 3271}# + #{tmp\ 3272}#))) + #{e2*\ 3268}# + #{e1*\ 3267}# + #{args*\ 3266}#)))) + (lambda (#{meta\ 3274}# #{lcase\ 3275}#) + (#{build-case-lambda\ 326}# + #{s\ 3248}# + #{meta\ 3274}# + #{lcase\ 3275}#)))) + #{tmp\ 3256}#) + (let ((#{_\ 3279}# #{tmp\ 3255}#)) (syntax-violation 'case-lambda "bad case-lambda*" - #{e\ 3251}#))))))) - (#{global-extend\ 375}# + #{e\ 3245}#))))))) + (#{global-extend\ 376}# 'core 'let (letrec* - ((#{chi-let\ 3287}# - (lambda (#{e\ 3288}# - #{r\ 3289}# - #{w\ 3290}# - #{s\ 3291}# - #{mod\ 3292}# - #{constructor\ 3293}# - #{ids\ 3294}# - #{vals\ 3295}# - #{exps\ 3296}#) - (if (not (#{valid-bound-ids?\ 439}# #{ids\ 3294}#)) + ((#{chi-let\ 3281}# + (lambda (#{e\ 3282}# + #{r\ 3283}# + #{w\ 3284}# + #{s\ 3285}# + #{mod\ 3286}# + #{constructor\ 3287}# + #{ids\ 3288}# + #{vals\ 3289}# + #{exps\ 3290}#) + (if (not (#{valid-bound-ids?\ 440}# #{ids\ 3288}#)) (syntax-violation 'let "duplicate bound variable" - #{e\ 3288}#) + #{e\ 3282}#) (begin - (let ((#{labels\ 3308}# - (#{gen-labels\ 394}# #{ids\ 3294}#)) - (#{new-vars\ 3309}# - (map #{gen-var\ 489}# #{ids\ 3294}#))) + (let ((#{labels\ 3302}# + (#{gen-labels\ 395}# #{ids\ 3288}#)) + (#{new-vars\ 3303}# + (map #{gen-var\ 488}# #{ids\ 3288}#))) (begin - (let ((#{nw\ 3312}# - (#{make-binding-wrap\ 423}# - #{ids\ 3294}# - #{labels\ 3308}# - #{w\ 3290}#)) - (#{nr\ 3313}# - (#{extend-var-env\ 369}# - #{labels\ 3308}# - #{new-vars\ 3309}# - #{r\ 3289}#))) - (#{constructor\ 3293}# - #{s\ 3291}# - (map syntax->datum #{ids\ 3294}#) - #{new-vars\ 3309}# - (map (lambda (#{x\ 3314}#) - (#{chi\ 461}# - #{x\ 3314}# - #{r\ 3289}# - #{w\ 3290}# - #{mod\ 3292}#)) - #{vals\ 3295}#) - (#{chi-body\ 469}# - #{exps\ 3296}# - (#{source-wrap\ 447}# - #{e\ 3288}# - #{nw\ 3312}# - #{s\ 3291}# - #{mod\ 3292}#) - #{nr\ 3313}# - #{nw\ 3312}# - #{mod\ 3292}#)))))))))) + (let ((#{nw\ 3306}# + (#{make-binding-wrap\ 424}# + #{ids\ 3288}# + #{labels\ 3302}# + #{w\ 3284}#)) + (#{nr\ 3307}# + (#{extend-var-env\ 370}# + #{labels\ 3302}# + #{new-vars\ 3303}# + #{r\ 3283}#))) + (#{constructor\ 3287}# + #{s\ 3285}# + (map syntax->datum #{ids\ 3288}#) + #{new-vars\ 3303}# + (map (lambda (#{x\ 3308}#) + (#{chi\ 460}# + #{x\ 3308}# + #{r\ 3283}# + #{w\ 3284}# + #{mod\ 3286}#)) + #{vals\ 3289}#) + (#{chi-body\ 468}# + #{exps\ 3290}# + (#{source-wrap\ 448}# + #{e\ 3282}# + #{nw\ 3306}# + #{s\ 3285}# + #{mod\ 3286}#) + #{nr\ 3307}# + #{nw\ 3306}# + #{mod\ 3286}#)))))))))) (begin - (lambda (#{e\ 3316}# - #{r\ 3317}# - #{w\ 3318}# - #{s\ 3319}# - #{mod\ 3320}#) - (let ((#{tmp\ 3326}# #{e\ 3316}#)) - (let ((#{tmp\ 3327}# + (lambda (#{e\ 3310}# + #{r\ 3311}# + #{w\ 3312}# + #{s\ 3313}# + #{mod\ 3314}#) + (let ((#{tmp\ 3320}# #{e\ 3310}#)) + (let ((#{tmp\ 3321}# ($sc-dispatch - #{tmp\ 3326}# + #{tmp\ 3320}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3327}# + (if (if #{tmp\ 3321}# (@apply - (lambda (#{id\ 3332}# - #{val\ 3333}# - #{e1\ 3334}# - #{e2\ 3335}#) - (and-map #{id?\ 379}# #{id\ 3332}#)) - #{tmp\ 3327}#) + (lambda (#{id\ 3326}# + #{val\ 3327}# + #{e1\ 3328}# + #{e2\ 3329}#) + (and-map #{id?\ 380}# #{id\ 3326}#)) + #{tmp\ 3321}#) #f) (@apply - (lambda (#{id\ 3341}# - #{val\ 3342}# - #{e1\ 3343}# - #{e2\ 3344}#) - (#{chi-let\ 3287}# - #{e\ 3316}# - #{r\ 3317}# - #{w\ 3318}# - #{s\ 3319}# - #{mod\ 3320}# - #{build-let\ 335}# - #{id\ 3341}# - #{val\ 3342}# - (cons #{e1\ 3343}# #{e2\ 3344}#))) - #{tmp\ 3327}#) - (let ((#{tmp\ 3348}# + (lambda (#{id\ 3335}# + #{val\ 3336}# + #{e1\ 3337}# + #{e2\ 3338}#) + (#{chi-let\ 3281}# + #{e\ 3310}# + #{r\ 3311}# + #{w\ 3312}# + #{s\ 3313}# + #{mod\ 3314}# + #{build-let\ 336}# + #{id\ 3335}# + #{val\ 3336}# + (cons #{e1\ 3337}# #{e2\ 3338}#))) + #{tmp\ 3321}#) + (let ((#{tmp\ 3342}# ($sc-dispatch - #{tmp\ 3326}# + #{tmp\ 3320}# '(_ any #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3348}# + (if (if #{tmp\ 3342}# (@apply - (lambda (#{f\ 3354}# - #{id\ 3355}# - #{val\ 3356}# - #{e1\ 3357}# - #{e2\ 3358}#) - (if (#{id?\ 379}# #{f\ 3354}#) - (and-map #{id?\ 379}# #{id\ 3355}#) + (lambda (#{f\ 3348}# + #{id\ 3349}# + #{val\ 3350}# + #{e1\ 3351}# + #{e2\ 3352}#) + (if (#{id?\ 380}# #{f\ 3348}#) + (and-map #{id?\ 380}# #{id\ 3349}#) #f)) - #{tmp\ 3348}#) + #{tmp\ 3342}#) #f) (@apply - (lambda (#{f\ 3367}# - #{id\ 3368}# - #{val\ 3369}# - #{e1\ 3370}# - #{e2\ 3371}#) - (#{chi-let\ 3287}# - #{e\ 3316}# - #{r\ 3317}# - #{w\ 3318}# - #{s\ 3319}# - #{mod\ 3320}# - #{build-named-let\ 337}# - (cons #{f\ 3367}# #{id\ 3368}#) - #{val\ 3369}# - (cons #{e1\ 3370}# #{e2\ 3371}#))) - #{tmp\ 3348}#) - (let ((#{_\ 3376}# #{tmp\ 3326}#)) + (lambda (#{f\ 3361}# + #{id\ 3362}# + #{val\ 3363}# + #{e1\ 3364}# + #{e2\ 3365}#) + (#{chi-let\ 3281}# + #{e\ 3310}# + #{r\ 3311}# + #{w\ 3312}# + #{s\ 3313}# + #{mod\ 3314}# + #{build-named-let\ 338}# + (cons #{f\ 3361}# #{id\ 3362}#) + #{val\ 3363}# + (cons #{e1\ 3364}# #{e2\ 3365}#))) + #{tmp\ 3342}#) + (let ((#{_\ 3370}# #{tmp\ 3320}#)) (syntax-violation 'let "bad let" - (#{source-wrap\ 447}# - #{e\ 3316}# - #{w\ 3318}# - #{s\ 3319}# - #{mod\ 3320}#)))))))))))) - (#{global-extend\ 375}# + (#{source-wrap\ 448}# + #{e\ 3310}# + #{w\ 3312}# + #{s\ 3313}# + #{mod\ 3314}#)))))))))))) + (#{global-extend\ 376}# 'core 'letrec - (lambda (#{e\ 3377}# - #{r\ 3378}# - #{w\ 3379}# - #{s\ 3380}# - #{mod\ 3381}#) - (let ((#{tmp\ 3387}# #{e\ 3377}#)) - (let ((#{tmp\ 3388}# + (lambda (#{e\ 3371}# + #{r\ 3372}# + #{w\ 3373}# + #{s\ 3374}# + #{mod\ 3375}#) + (let ((#{tmp\ 3381}# #{e\ 3371}#)) + (let ((#{tmp\ 3382}# ($sc-dispatch - #{tmp\ 3387}# + #{tmp\ 3381}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3388}# + (if (if #{tmp\ 3382}# (@apply - (lambda (#{id\ 3393}# - #{val\ 3394}# - #{e1\ 3395}# - #{e2\ 3396}#) - (and-map #{id?\ 379}# #{id\ 3393}#)) - #{tmp\ 3388}#) + (lambda (#{id\ 3387}# + #{val\ 3388}# + #{e1\ 3389}# + #{e2\ 3390}#) + (and-map #{id?\ 380}# #{id\ 3387}#)) + #{tmp\ 3382}#) #f) (@apply - (lambda (#{id\ 3402}# - #{val\ 3403}# - #{e1\ 3404}# - #{e2\ 3405}#) + (lambda (#{id\ 3396}# + #{val\ 3397}# + #{e1\ 3398}# + #{e2\ 3399}#) (begin - (let ((#{ids\ 3407}# #{id\ 3402}#)) - (if (not (#{valid-bound-ids?\ 439}# - #{ids\ 3407}#)) + (let ((#{ids\ 3401}# #{id\ 3396}#)) + (if (not (#{valid-bound-ids?\ 440}# + #{ids\ 3401}#)) (syntax-violation 'letrec "duplicate bound variable" - #{e\ 3377}#) + #{e\ 3371}#) (begin - (let ((#{labels\ 3411}# - (#{gen-labels\ 394}# #{ids\ 3407}#)) - (#{new-vars\ 3412}# - (map #{gen-var\ 489}# - #{ids\ 3407}#))) + (let ((#{labels\ 3405}# + (#{gen-labels\ 395}# #{ids\ 3401}#)) + (#{new-vars\ 3406}# + (map #{gen-var\ 488}# + #{ids\ 3401}#))) (begin - (let ((#{w\ 3415}# - (#{make-binding-wrap\ 423}# - #{ids\ 3407}# - #{labels\ 3411}# - #{w\ 3379}#)) - (#{r\ 3416}# - (#{extend-var-env\ 369}# - #{labels\ 3411}# - #{new-vars\ 3412}# - #{r\ 3378}#))) - (#{build-letrec\ 339}# - #{s\ 3380}# + (let ((#{w\ 3409}# + (#{make-binding-wrap\ 424}# + #{ids\ 3401}# + #{labels\ 3405}# + #{w\ 3373}#)) + (#{r\ 3410}# + (#{extend-var-env\ 370}# + #{labels\ 3405}# + #{new-vars\ 3406}# + #{r\ 3372}#))) + (#{build-letrec\ 340}# + #{s\ 3374}# #f - (map syntax->datum #{ids\ 3407}#) - #{new-vars\ 3412}# - (map (lambda (#{x\ 3417}#) - (#{chi\ 461}# - #{x\ 3417}# - #{r\ 3416}# - #{w\ 3415}# - #{mod\ 3381}#)) - #{val\ 3403}#) - (#{chi-body\ 469}# - (cons #{e1\ 3404}# #{e2\ 3405}#) - (#{source-wrap\ 447}# - #{e\ 3377}# - #{w\ 3415}# - #{s\ 3380}# - #{mod\ 3381}#) - #{r\ 3416}# - #{w\ 3415}# - #{mod\ 3381}#)))))))))) - #{tmp\ 3388}#) - (let ((#{_\ 3422}# #{tmp\ 3387}#)) + (map syntax->datum #{ids\ 3401}#) + #{new-vars\ 3406}# + (map (lambda (#{x\ 3411}#) + (#{chi\ 460}# + #{x\ 3411}# + #{r\ 3410}# + #{w\ 3409}# + #{mod\ 3375}#)) + #{val\ 3397}#) + (#{chi-body\ 468}# + (cons #{e1\ 3398}# #{e2\ 3399}#) + (#{source-wrap\ 448}# + #{e\ 3371}# + #{w\ 3409}# + #{s\ 3374}# + #{mod\ 3375}#) + #{r\ 3410}# + #{w\ 3409}# + #{mod\ 3375}#)))))))))) + #{tmp\ 3382}#) + (let ((#{_\ 3416}# #{tmp\ 3381}#)) (syntax-violation 'letrec "bad letrec" - (#{source-wrap\ 447}# - #{e\ 3377}# - #{w\ 3379}# - #{s\ 3380}# - #{mod\ 3381}#)))))))) - (#{global-extend\ 375}# + (#{source-wrap\ 448}# + #{e\ 3371}# + #{w\ 3373}# + #{s\ 3374}# + #{mod\ 3375}#)))))))) + (#{global-extend\ 376}# 'core 'letrec* - (lambda (#{e\ 3423}# - #{r\ 3424}# - #{w\ 3425}# - #{s\ 3426}# - #{mod\ 3427}#) - (let ((#{tmp\ 3433}# #{e\ 3423}#)) - (let ((#{tmp\ 3434}# + (lambda (#{e\ 3417}# + #{r\ 3418}# + #{w\ 3419}# + #{s\ 3420}# + #{mod\ 3421}#) + (let ((#{tmp\ 3427}# #{e\ 3417}#)) + (let ((#{tmp\ 3428}# ($sc-dispatch - #{tmp\ 3433}# + #{tmp\ 3427}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3434}# + (if (if #{tmp\ 3428}# (@apply - (lambda (#{id\ 3439}# - #{val\ 3440}# - #{e1\ 3441}# - #{e2\ 3442}#) - (and-map #{id?\ 379}# #{id\ 3439}#)) - #{tmp\ 3434}#) + (lambda (#{id\ 3433}# + #{val\ 3434}# + #{e1\ 3435}# + #{e2\ 3436}#) + (and-map #{id?\ 380}# #{id\ 3433}#)) + #{tmp\ 3428}#) #f) (@apply - (lambda (#{id\ 3448}# - #{val\ 3449}# - #{e1\ 3450}# - #{e2\ 3451}#) + (lambda (#{id\ 3442}# + #{val\ 3443}# + #{e1\ 3444}# + #{e2\ 3445}#) (begin - (let ((#{ids\ 3453}# #{id\ 3448}#)) - (if (not (#{valid-bound-ids?\ 439}# - #{ids\ 3453}#)) + (let ((#{ids\ 3447}# #{id\ 3442}#)) + (if (not (#{valid-bound-ids?\ 440}# + #{ids\ 3447}#)) (syntax-violation 'letrec* "duplicate bound variable" - #{e\ 3423}#) + #{e\ 3417}#) (begin - (let ((#{labels\ 3457}# - (#{gen-labels\ 394}# #{ids\ 3453}#)) - (#{new-vars\ 3458}# - (map #{gen-var\ 489}# - #{ids\ 3453}#))) + (let ((#{labels\ 3451}# + (#{gen-labels\ 395}# #{ids\ 3447}#)) + (#{new-vars\ 3452}# + (map #{gen-var\ 488}# + #{ids\ 3447}#))) (begin - (let ((#{w\ 3461}# - (#{make-binding-wrap\ 423}# - #{ids\ 3453}# - #{labels\ 3457}# - #{w\ 3425}#)) - (#{r\ 3462}# - (#{extend-var-env\ 369}# - #{labels\ 3457}# - #{new-vars\ 3458}# - #{r\ 3424}#))) - (#{build-letrec\ 339}# - #{s\ 3426}# + (let ((#{w\ 3455}# + (#{make-binding-wrap\ 424}# + #{ids\ 3447}# + #{labels\ 3451}# + #{w\ 3419}#)) + (#{r\ 3456}# + (#{extend-var-env\ 370}# + #{labels\ 3451}# + #{new-vars\ 3452}# + #{r\ 3418}#))) + (#{build-letrec\ 340}# + #{s\ 3420}# #t - (map syntax->datum #{ids\ 3453}#) - #{new-vars\ 3458}# - (map (lambda (#{x\ 3463}#) - (#{chi\ 461}# - #{x\ 3463}# - #{r\ 3462}# - #{w\ 3461}# - #{mod\ 3427}#)) - #{val\ 3449}#) - (#{chi-body\ 469}# - (cons #{e1\ 3450}# #{e2\ 3451}#) - (#{source-wrap\ 447}# - #{e\ 3423}# - #{w\ 3461}# - #{s\ 3426}# - #{mod\ 3427}#) - #{r\ 3462}# - #{w\ 3461}# - #{mod\ 3427}#)))))))))) - #{tmp\ 3434}#) - (let ((#{_\ 3468}# #{tmp\ 3433}#)) + (map syntax->datum #{ids\ 3447}#) + #{new-vars\ 3452}# + (map (lambda (#{x\ 3457}#) + (#{chi\ 460}# + #{x\ 3457}# + #{r\ 3456}# + #{w\ 3455}# + #{mod\ 3421}#)) + #{val\ 3443}#) + (#{chi-body\ 468}# + (cons #{e1\ 3444}# #{e2\ 3445}#) + (#{source-wrap\ 448}# + #{e\ 3417}# + #{w\ 3455}# + #{s\ 3420}# + #{mod\ 3421}#) + #{r\ 3456}# + #{w\ 3455}# + #{mod\ 3421}#)))))))))) + #{tmp\ 3428}#) + (let ((#{_\ 3462}# #{tmp\ 3427}#)) (syntax-violation 'letrec* "bad letrec*" - (#{source-wrap\ 447}# - #{e\ 3423}# - #{w\ 3425}# - #{s\ 3426}# - #{mod\ 3427}#)))))))) - (#{global-extend\ 375}# + (#{source-wrap\ 448}# + #{e\ 3417}# + #{w\ 3419}# + #{s\ 3420}# + #{mod\ 3421}#)))))))) + (#{global-extend\ 376}# 'core 'set! - (lambda (#{e\ 3469}# - #{r\ 3470}# - #{w\ 3471}# - #{s\ 3472}# - #{mod\ 3473}#) - (let ((#{tmp\ 3479}# #{e\ 3469}#)) - (let ((#{tmp\ 3480}# - ($sc-dispatch #{tmp\ 3479}# '(_ any any)))) - (if (if #{tmp\ 3480}# + (lambda (#{e\ 3463}# + #{r\ 3464}# + #{w\ 3465}# + #{s\ 3466}# + #{mod\ 3467}#) + (let ((#{tmp\ 3473}# #{e\ 3463}#)) + (let ((#{tmp\ 3474}# + ($sc-dispatch #{tmp\ 3473}# '(_ any any)))) + (if (if #{tmp\ 3474}# (@apply - (lambda (#{id\ 3483}# #{val\ 3484}#) - (#{id?\ 379}# #{id\ 3483}#)) - #{tmp\ 3480}#) + (lambda (#{id\ 3477}# #{val\ 3478}#) + (#{id?\ 380}# #{id\ 3477}#)) + #{tmp\ 3474}#) #f) (@apply - (lambda (#{id\ 3487}# #{val\ 3488}#) + (lambda (#{id\ 3481}# #{val\ 3482}#) (begin - (let ((#{n\ 3491}# - (#{id-var-name\ 433}# - #{id\ 3487}# - #{w\ 3471}#)) - (#{id-mod\ 3492}# - (if (#{syntax-object?\ 345}# #{id\ 3487}#) - (#{syntax-object-module\ 351}# - #{id\ 3487}#) - #{mod\ 3473}#))) + (let ((#{n\ 3485}# + (#{id-var-name\ 434}# + #{id\ 3481}# + #{w\ 3465}#)) + (#{id-mod\ 3486}# + (if (#{syntax-object?\ 346}# #{id\ 3481}#) + (#{syntax-object-module\ 352}# + #{id\ 3481}#) + #{mod\ 3467}#))) (begin - (let ((#{b\ 3494}# - (#{lookup\ 373}# - #{n\ 3491}# - #{r\ 3470}# - #{id-mod\ 3492}#))) + (let ((#{b\ 3488}# + (#{lookup\ 374}# + #{n\ 3485}# + #{r\ 3464}# + #{id-mod\ 3486}#))) (begin - (let ((#{atom-key\ 3497}# - (car #{b\ 3494}#))) - (if (eqv? #{atom-key\ 3497}# 'lexical) - (#{build-lexical-assignment\ 313}# - #{s\ 3472}# - (syntax->datum #{id\ 3487}#) - (cdr #{b\ 3494}#) - (#{chi\ 461}# - #{val\ 3488}# - #{r\ 3470}# - #{w\ 3471}# - #{mod\ 3473}#)) - (if (eqv? #{atom-key\ 3497}# 'global) - (#{build-global-assignment\ 319}# - #{s\ 3472}# - #{n\ 3491}# - (#{chi\ 461}# - #{val\ 3488}# - #{r\ 3470}# - #{w\ 3471}# - #{mod\ 3473}#) - #{id-mod\ 3492}#) - (if (eqv? #{atom-key\ 3497}# 'macro) + (let ((#{atom-key\ 3491}# + (car #{b\ 3488}#))) + (if (eqv? #{atom-key\ 3491}# 'lexical) + (#{build-lexical-assignment\ 314}# + #{s\ 3466}# + (syntax->datum #{id\ 3481}#) + (cdr #{b\ 3488}#) + (#{chi\ 460}# + #{val\ 3482}# + #{r\ 3464}# + #{w\ 3465}# + #{mod\ 3467}#)) + (if (eqv? #{atom-key\ 3491}# 'global) + (#{build-global-assignment\ 320}# + #{s\ 3466}# + #{n\ 3485}# + (#{chi\ 460}# + #{val\ 3482}# + #{r\ 3464}# + #{w\ 3465}# + #{mod\ 3467}#) + #{id-mod\ 3486}#) + (if (eqv? #{atom-key\ 3491}# 'macro) (begin - (let ((#{p\ 3504}# - (cdr #{b\ 3494}#))) + (let ((#{p\ 3498}# + (cdr #{b\ 3488}#))) (if (procedure-property - #{p\ 3504}# + #{p\ 3498}# 'variable-transformer) - (#{chi\ 461}# - (#{chi-macro\ 467}# - #{p\ 3504}# - #{e\ 3469}# - #{r\ 3470}# - #{w\ 3471}# - #{s\ 3472}# + (#{chi\ 460}# + (#{chi-macro\ 466}# + #{p\ 3498}# + #{e\ 3463}# + #{r\ 3464}# + #{w\ 3465}# + #{s\ 3466}# #f - #{mod\ 3473}#) - #{r\ 3470}# + #{mod\ 3467}#) + #{r\ 3464}# '(()) - #{mod\ 3473}#) + #{mod\ 3467}#) (syntax-violation 'set! "not a variable transformer" - (#{wrap\ 445}# - #{e\ 3469}# - #{w\ 3471}# - #{mod\ 3473}#) - (#{wrap\ 445}# - #{id\ 3487}# - #{w\ 3471}# - #{id-mod\ 3492}#))))) - (if (eqv? #{atom-key\ 3497}# + (#{wrap\ 446}# + #{e\ 3463}# + #{w\ 3465}# + #{mod\ 3467}#) + (#{wrap\ 446}# + #{id\ 3481}# + #{w\ 3465}# + #{id-mod\ 3486}#))))) + (if (eqv? #{atom-key\ 3491}# 'displaced-lexical) (syntax-violation 'set! "identifier out of context" - (#{wrap\ 445}# - #{id\ 3487}# - #{w\ 3471}# - #{mod\ 3473}#)) + (#{wrap\ 446}# + #{id\ 3481}# + #{w\ 3465}# + #{mod\ 3467}#)) (syntax-violation 'set! "bad set!" - (#{source-wrap\ 447}# - #{e\ 3469}# - #{w\ 3471}# - #{s\ 3472}# - #{mod\ 3473}#))))))))))))) - #{tmp\ 3480}#) - (let ((#{tmp\ 3509}# + (#{source-wrap\ 448}# + #{e\ 3463}# + #{w\ 3465}# + #{s\ 3466}# + #{mod\ 3467}#))))))))))))) + #{tmp\ 3474}#) + (let ((#{tmp\ 3503}# ($sc-dispatch - #{tmp\ 3479}# + #{tmp\ 3473}# '(_ (any . each-any) any)))) - (if #{tmp\ 3509}# + (if #{tmp\ 3503}# (@apply - (lambda (#{head\ 3513}# - #{tail\ 3514}# - #{val\ 3515}#) + (lambda (#{head\ 3507}# + #{tail\ 3508}# + #{val\ 3509}#) (call-with-values (lambda () - (#{syntax-type\ 457}# - #{head\ 3513}# - #{r\ 3470}# + (#{syntax-type\ 458}# + #{head\ 3507}# + #{r\ 3464}# '(()) #f #f - #{mod\ 3473}# + #{mod\ 3467}# #t)) - (lambda (#{type\ 3518}# - #{value\ 3519}# - #{ee\ 3520}# - #{ww\ 3521}# - #{ss\ 3522}# - #{modmod\ 3523}#) - (if (eqv? #{type\ 3518}# 'module-ref) + (lambda (#{type\ 3512}# + #{value\ 3513}# + #{ee\ 3514}# + #{ww\ 3515}# + #{ss\ 3516}# + #{modmod\ 3517}#) + (if (eqv? #{type\ 3512}# 'module-ref) (begin - (let ((#{val\ 3532}# - (#{chi\ 461}# - #{val\ 3515}# - #{r\ 3470}# - #{w\ 3471}# - #{mod\ 3473}#))) + (let ((#{val\ 3526}# + (#{chi\ 460}# + #{val\ 3509}# + #{r\ 3464}# + #{w\ 3465}# + #{mod\ 3467}#))) (call-with-values (lambda () - (#{value\ 3519}# - (cons #{head\ 3513}# - #{tail\ 3514}#) - #{r\ 3470}# - #{w\ 3471}#)) - (lambda (#{e\ 3534}# - #{r\ 3535}# - #{w\ 3536}# - #{s*\ 3537}# - #{mod\ 3538}#) - (let ((#{tmp\ 3544}# #{e\ 3534}#)) - (let ((#{tmp\ 3545}# - (list #{tmp\ 3544}#))) - (if (if #{tmp\ 3545}# + (#{value\ 3513}# + (cons #{head\ 3507}# + #{tail\ 3508}#) + #{r\ 3464}# + #{w\ 3465}#)) + (lambda (#{e\ 3528}# + #{r\ 3529}# + #{w\ 3530}# + #{s*\ 3531}# + #{mod\ 3532}#) + (let ((#{tmp\ 3538}# #{e\ 3528}#)) + (let ((#{tmp\ 3539}# + (list #{tmp\ 3538}#))) + (if (if #{tmp\ 3539}# (@apply - (lambda (#{e\ 3547}#) - (#{id?\ 379}# - #{e\ 3547}#)) - #{tmp\ 3545}#) + (lambda (#{e\ 3541}#) + (#{id?\ 380}# + #{e\ 3541}#)) + #{tmp\ 3539}#) #f) (@apply - (lambda (#{e\ 3549}#) - (#{build-global-assignment\ 319}# - #{s\ 3472}# + (lambda (#{e\ 3543}#) + (#{build-global-assignment\ 320}# + #{s\ 3466}# (syntax->datum - #{e\ 3549}#) - #{val\ 3532}# - #{mod\ 3538}#)) - #{tmp\ 3545}#) + #{e\ 3543}#) + #{val\ 3526}# + #{mod\ 3532}#)) + #{tmp\ 3539}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3544}#)))))))) - (#{build-application\ 305}# - #{s\ 3472}# - (#{chi\ 461}# + #{tmp\ 3538}#)))))))) + (#{build-application\ 306}# + #{s\ 3466}# + (#{chi\ 460}# (list '#(syntax-object setter ((top) @@ -10197,16 +10231,16 @@ (top) (top) (top)) - #("i3524" - "i3525" - "i3526" - "i3527" - "i3528" - "i3529")) + #("i3518" + "i3519" + "i3520" + "i3521" + "i3522" + "i3523")) #(ribcage #(head tail val) #((top) (top) (top)) - #("i3510" "i3511" "i3512")) + #("i3504" "i3505" "i3506")) #(ribcage () () ()) #(ribcage #(e r w s mod) @@ -10215,11 +10249,11 @@ (top) (top) (top)) - #("i3474" - "i3475" - "i3476" - "i3477" - "i3478")) + #("i3468" + "i3469" + "i3470" + "i3471" + "i3472")) #(ribcage (lambda-var-list gen-var @@ -10237,7 +10271,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -10493,60 +10526,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -10555,135 +10587,134 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile)) - #{head\ 3513}#) - #{r\ 3470}# - #{w\ 3471}# - #{mod\ 3473}#) - (map (lambda (#{e\ 3551}#) - (#{chi\ 461}# - #{e\ 3551}# - #{r\ 3470}# - #{w\ 3471}# - #{mod\ 3473}#)) + #{head\ 3507}#) + #{r\ 3464}# + #{w\ 3465}# + #{mod\ 3467}#) + (map (lambda (#{e\ 3545}#) + (#{chi\ 460}# + #{e\ 3545}# + #{r\ 3464}# + #{w\ 3465}# + #{mod\ 3467}#)) (append - #{tail\ 3514}# - (list #{val\ 3515}#)))))))) - #{tmp\ 3509}#) - (let ((#{_\ 3555}# #{tmp\ 3479}#)) + #{tail\ 3508}# + (list #{val\ 3509}#)))))))) + #{tmp\ 3503}#) + (let ((#{_\ 3549}# #{tmp\ 3473}#)) (syntax-violation 'set! "bad set!" - (#{source-wrap\ 447}# - #{e\ 3469}# - #{w\ 3471}# - #{s\ 3472}# - #{mod\ 3473}#)))))))))) - (#{global-extend\ 375}# + (#{source-wrap\ 448}# + #{e\ 3463}# + #{w\ 3465}# + #{s\ 3466}# + #{mod\ 3467}#)))))))))) + (#{global-extend\ 376}# 'module-ref '@ - (lambda (#{e\ 3556}# #{r\ 3557}# #{w\ 3558}#) - (let ((#{tmp\ 3562}# #{e\ 3556}#)) - (let ((#{tmp\ 3563}# - ($sc-dispatch #{tmp\ 3562}# '(_ each-any any)))) - (if (if #{tmp\ 3563}# + (lambda (#{e\ 3550}# #{r\ 3551}# #{w\ 3552}#) + (let ((#{tmp\ 3556}# #{e\ 3550}#)) + (let ((#{tmp\ 3557}# + ($sc-dispatch #{tmp\ 3556}# '(_ each-any any)))) + (if (if #{tmp\ 3557}# (@apply - (lambda (#{mod\ 3566}# #{id\ 3567}#) - (if (and-map #{id?\ 379}# #{mod\ 3566}#) - (#{id?\ 379}# #{id\ 3567}#) + (lambda (#{mod\ 3560}# #{id\ 3561}#) + (if (and-map #{id?\ 380}# #{mod\ 3560}#) + (#{id?\ 380}# #{id\ 3561}#) #f)) - #{tmp\ 3563}#) + #{tmp\ 3557}#) #f) (@apply - (lambda (#{mod\ 3573}# #{id\ 3574}#) + (lambda (#{mod\ 3567}# #{id\ 3568}#) (values - (syntax->datum #{id\ 3574}#) - #{r\ 3557}# - #{w\ 3558}# + (syntax->datum #{id\ 3568}#) + #{r\ 3551}# + #{w\ 3552}# #f (syntax->datum (cons '#(syntax-object @@ -10692,12 +10723,12 @@ #(ribcage #(mod id) #((top) (top)) - #("i3571" "i3572")) + #("i3565" "i3566")) #(ribcage () () ()) #(ribcage #(e r w) #((top) (top) (top)) - #("i3559" "i3560" "i3561")) + #("i3553" "i3554" "i3555")) #(ribcage (lambda-var-list gen-var @@ -10715,7 +10746,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -10971,60 +11001,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -11033,160 +11062,159 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile)) - #{mod\ 3573}#)))) - #{tmp\ 3563}#) + #{mod\ 3567}#)))) + #{tmp\ 3557}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3562}#)))))) - (#{global-extend\ 375}# + #{tmp\ 3556}#)))))) + (#{global-extend\ 376}# 'module-ref '@@ - (lambda (#{e\ 3576}# #{r\ 3577}# #{w\ 3578}#) + (lambda (#{e\ 3570}# #{r\ 3571}# #{w\ 3572}#) (letrec* - ((#{remodulate\ 3583}# - (lambda (#{x\ 3584}# #{mod\ 3585}#) - (if (pair? #{x\ 3584}#) - (cons (#{remodulate\ 3583}# - (car #{x\ 3584}#) - #{mod\ 3585}#) - (#{remodulate\ 3583}# - (cdr #{x\ 3584}#) - #{mod\ 3585}#)) - (if (#{syntax-object?\ 345}# #{x\ 3584}#) - (#{make-syntax-object\ 343}# - (#{remodulate\ 3583}# - (#{syntax-object-expression\ 347}# #{x\ 3584}#) - #{mod\ 3585}#) - (#{syntax-object-wrap\ 349}# #{x\ 3584}#) - #{mod\ 3585}#) - (if (vector? #{x\ 3584}#) + ((#{remodulate\ 3577}# + (lambda (#{x\ 3578}# #{mod\ 3579}#) + (if (pair? #{x\ 3578}#) + (cons (#{remodulate\ 3577}# + (car #{x\ 3578}#) + #{mod\ 3579}#) + (#{remodulate\ 3577}# + (cdr #{x\ 3578}#) + #{mod\ 3579}#)) + (if (#{syntax-object?\ 346}# #{x\ 3578}#) + (#{make-syntax-object\ 344}# + (#{remodulate\ 3577}# + (#{syntax-object-expression\ 348}# #{x\ 3578}#) + #{mod\ 3579}#) + (#{syntax-object-wrap\ 350}# #{x\ 3578}#) + #{mod\ 3579}#) + (if (vector? #{x\ 3578}#) (begin - (let ((#{n\ 3596}# (vector-length #{x\ 3584}#))) + (let ((#{n\ 3590}# (vector-length #{x\ 3578}#))) (begin - (let ((#{v\ 3598}# - (make-vector #{n\ 3596}#))) + (let ((#{v\ 3592}# + (make-vector #{n\ 3590}#))) (letrec* - ((#{loop\ 3601}# - (lambda (#{i\ 3602}#) - (if (#{fx=\ 286}# - #{i\ 3602}# - #{n\ 3596}#) - (begin (if #f #f) #{v\ 3598}#) + ((#{loop\ 3595}# + (lambda (#{i\ 3596}#) + (if (#{fx=\ 287}# + #{i\ 3596}# + #{n\ 3590}#) + (begin (if #f #f) #{v\ 3592}#) (begin (vector-set! - #{v\ 3598}# - #{i\ 3602}# - (#{remodulate\ 3583}# + #{v\ 3592}# + #{i\ 3596}# + (#{remodulate\ 3577}# (vector-ref - #{x\ 3584}# - #{i\ 3602}#) - #{mod\ 3585}#)) - (#{loop\ 3601}# - (#{fx+\ 282}# - #{i\ 3602}# + #{x\ 3578}# + #{i\ 3596}#) + #{mod\ 3579}#)) + (#{loop\ 3595}# + (#{fx+\ 283}# + #{i\ 3596}# 1))))))) - (begin (#{loop\ 3601}# 0))))))) - #{x\ 3584}#)))))) + (begin (#{loop\ 3595}# 0))))))) + #{x\ 3578}#)))))) (begin - (let ((#{tmp\ 3606}# #{e\ 3576}#)) - (let ((#{tmp\ 3607}# - ($sc-dispatch #{tmp\ 3606}# '(_ each-any any)))) - (if (if #{tmp\ 3607}# + (let ((#{tmp\ 3600}# #{e\ 3570}#)) + (let ((#{tmp\ 3601}# + ($sc-dispatch #{tmp\ 3600}# '(_ each-any any)))) + (if (if #{tmp\ 3601}# (@apply - (lambda (#{mod\ 3610}# #{exp\ 3611}#) - (and-map #{id?\ 379}# #{mod\ 3610}#)) - #{tmp\ 3607}#) + (lambda (#{mod\ 3604}# #{exp\ 3605}#) + (and-map #{id?\ 380}# #{mod\ 3604}#)) + #{tmp\ 3601}#) #f) (@apply - (lambda (#{mod\ 3615}# #{exp\ 3616}#) + (lambda (#{mod\ 3609}# #{exp\ 3610}#) (begin - (let ((#{mod\ 3618}# + (let ((#{mod\ 3612}# (syntax->datum (cons '#(syntax-object private @@ -11194,17 +11222,17 @@ #(ribcage #(mod exp) #((top) (top)) - #("i3613" "i3614")) + #("i3607" "i3608")) #(ribcage (remodulate) ((top)) - ("i3582")) + ("i3576")) #(ribcage #(e r w) #((top) (top) (top)) - #("i3579" - "i3580" - "i3581")) + #("i3573" + "i3574" + "i3575")) #(ribcage (lambda-var-list gen-var @@ -11222,7 +11250,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -11478,60 +11505,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -11540,264 +11566,263 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile)) - #{mod\ 3615}#)))) + #{mod\ 3609}#)))) (values - (#{remodulate\ 3583}# - #{exp\ 3616}# - #{mod\ 3618}#) - #{r\ 3577}# - #{w\ 3578}# - (#{source-annotation\ 360}# #{exp\ 3616}#) - #{mod\ 3618}#)))) - #{tmp\ 3607}#) + (#{remodulate\ 3577}# + #{exp\ 3610}# + #{mod\ 3612}#) + #{r\ 3571}# + #{w\ 3572}# + (#{source-annotation\ 361}# #{exp\ 3610}#) + #{mod\ 3612}#)))) + #{tmp\ 3601}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3606}#)))))))) - (#{global-extend\ 375}# + #{tmp\ 3600}#)))))))) + (#{global-extend\ 376}# 'core 'if - (lambda (#{e\ 3620}# - #{r\ 3621}# - #{w\ 3622}# - #{s\ 3623}# - #{mod\ 3624}#) - (let ((#{tmp\ 3630}# #{e\ 3620}#)) - (let ((#{tmp\ 3631}# - ($sc-dispatch #{tmp\ 3630}# '(_ any any)))) - (if #{tmp\ 3631}# + (lambda (#{e\ 3614}# + #{r\ 3615}# + #{w\ 3616}# + #{s\ 3617}# + #{mod\ 3618}#) + (let ((#{tmp\ 3624}# #{e\ 3614}#)) + (let ((#{tmp\ 3625}# + ($sc-dispatch #{tmp\ 3624}# '(_ any any)))) + (if #{tmp\ 3625}# (@apply - (lambda (#{test\ 3634}# #{then\ 3635}#) - (#{build-conditional\ 307}# - #{s\ 3623}# - (#{chi\ 461}# - #{test\ 3634}# - #{r\ 3621}# - #{w\ 3622}# - #{mod\ 3624}#) - (#{chi\ 461}# - #{then\ 3635}# - #{r\ 3621}# - #{w\ 3622}# - #{mod\ 3624}#) - (#{build-void\ 303}# #f))) - #{tmp\ 3631}#) - (let ((#{tmp\ 3637}# - ($sc-dispatch #{tmp\ 3630}# '(_ any any any)))) - (if #{tmp\ 3637}# + (lambda (#{test\ 3628}# #{then\ 3629}#) + (#{build-conditional\ 308}# + #{s\ 3617}# + (#{chi\ 460}# + #{test\ 3628}# + #{r\ 3615}# + #{w\ 3616}# + #{mod\ 3618}#) + (#{chi\ 460}# + #{then\ 3629}# + #{r\ 3615}# + #{w\ 3616}# + #{mod\ 3618}#) + (#{build-void\ 304}# #f))) + #{tmp\ 3625}#) + (let ((#{tmp\ 3631}# + ($sc-dispatch #{tmp\ 3624}# '(_ any any any)))) + (if #{tmp\ 3631}# (@apply - (lambda (#{test\ 3641}# - #{then\ 3642}# - #{else\ 3643}#) - (#{build-conditional\ 307}# - #{s\ 3623}# - (#{chi\ 461}# - #{test\ 3641}# - #{r\ 3621}# - #{w\ 3622}# - #{mod\ 3624}#) - (#{chi\ 461}# - #{then\ 3642}# - #{r\ 3621}# - #{w\ 3622}# - #{mod\ 3624}#) - (#{chi\ 461}# - #{else\ 3643}# - #{r\ 3621}# - #{w\ 3622}# - #{mod\ 3624}#))) - #{tmp\ 3637}#) + (lambda (#{test\ 3635}# + #{then\ 3636}# + #{else\ 3637}#) + (#{build-conditional\ 308}# + #{s\ 3617}# + (#{chi\ 460}# + #{test\ 3635}# + #{r\ 3615}# + #{w\ 3616}# + #{mod\ 3618}#) + (#{chi\ 460}# + #{then\ 3636}# + #{r\ 3615}# + #{w\ 3616}# + #{mod\ 3618}#) + (#{chi\ 460}# + #{else\ 3637}# + #{r\ 3615}# + #{w\ 3616}# + #{mod\ 3618}#))) + #{tmp\ 3631}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3630}#)))))))) - (#{global-extend\ 375}# + #{tmp\ 3624}#)))))))) + (#{global-extend\ 376}# 'core 'with-fluids - (lambda (#{e\ 3644}# - #{r\ 3645}# - #{w\ 3646}# - #{s\ 3647}# - #{mod\ 3648}#) - (let ((#{tmp\ 3654}# #{e\ 3644}#)) - (let ((#{tmp\ 3655}# + (lambda (#{e\ 3638}# + #{r\ 3639}# + #{w\ 3640}# + #{s\ 3641}# + #{mod\ 3642}#) + (let ((#{tmp\ 3648}# #{e\ 3638}#)) + (let ((#{tmp\ 3649}# ($sc-dispatch - #{tmp\ 3654}# + #{tmp\ 3648}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 3655}# + (if #{tmp\ 3649}# (@apply - (lambda (#{fluid\ 3660}# - #{val\ 3661}# - #{b\ 3662}# - #{b*\ 3663}#) - (#{build-dynlet\ 309}# - #{s\ 3647}# - (map (lambda (#{x\ 3664}#) - (#{chi\ 461}# - #{x\ 3664}# - #{r\ 3645}# - #{w\ 3646}# - #{mod\ 3648}#)) - #{fluid\ 3660}#) - (map (lambda (#{x\ 3667}#) - (#{chi\ 461}# - #{x\ 3667}# - #{r\ 3645}# - #{w\ 3646}# - #{mod\ 3648}#)) - #{val\ 3661}#) - (#{chi-body\ 469}# - (cons #{b\ 3662}# #{b*\ 3663}#) - (#{source-wrap\ 447}# - #{e\ 3644}# - #{w\ 3646}# - #{s\ 3647}# - #{mod\ 3648}#) - #{r\ 3645}# - #{w\ 3646}# - #{mod\ 3648}#))) - #{tmp\ 3655}#) + (lambda (#{fluid\ 3654}# + #{val\ 3655}# + #{b\ 3656}# + #{b*\ 3657}#) + (#{build-dynlet\ 310}# + #{s\ 3641}# + (map (lambda (#{x\ 3658}#) + (#{chi\ 460}# + #{x\ 3658}# + #{r\ 3639}# + #{w\ 3640}# + #{mod\ 3642}#)) + #{fluid\ 3654}#) + (map (lambda (#{x\ 3661}#) + (#{chi\ 460}# + #{x\ 3661}# + #{r\ 3639}# + #{w\ 3640}# + #{mod\ 3642}#)) + #{val\ 3655}#) + (#{chi-body\ 468}# + (cons #{b\ 3656}# #{b*\ 3657}#) + (#{source-wrap\ 448}# + #{e\ 3638}# + #{w\ 3640}# + #{s\ 3641}# + #{mod\ 3642}#) + #{r\ 3639}# + #{w\ 3640}# + #{mod\ 3642}#))) + #{tmp\ 3649}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3654}#)))))) - (#{global-extend\ 375}# 'begin 'begin '()) - (#{global-extend\ 375}# 'define 'define '()) - (#{global-extend\ 375}# + #{tmp\ 3648}#)))))) + (#{global-extend\ 376}# 'begin 'begin '()) + (#{global-extend\ 376}# 'define 'define '()) + (#{global-extend\ 376}# 'define-syntax 'define-syntax '()) - (#{global-extend\ 375}# + (#{global-extend\ 376}# 'eval-when 'eval-when '()) - (#{global-extend\ 375}# + (#{global-extend\ 376}# 'core 'syntax-case (letrec* - ((#{convert-pattern\ 3672}# - (lambda (#{pattern\ 3679}# #{keys\ 3680}#) + ((#{convert-pattern\ 3666}# + (lambda (#{pattern\ 3673}# #{keys\ 3674}#) (letrec* - ((#{cvt*\ 3684}# - (lambda (#{p*\ 3687}# #{n\ 3688}# #{ids\ 3689}#) - (if (null? #{p*\ 3687}#) - (values '() #{ids\ 3689}#) + ((#{cvt*\ 3678}# + (lambda (#{p*\ 3681}# #{n\ 3682}# #{ids\ 3683}#) + (if (null? #{p*\ 3681}#) + (values '() #{ids\ 3683}#) (call-with-values (lambda () - (#{cvt*\ 3684}# - (cdr #{p*\ 3687}#) - #{n\ 3688}# - #{ids\ 3689}#)) - (lambda (#{y\ 3693}# #{ids\ 3694}#) + (#{cvt*\ 3678}# + (cdr #{p*\ 3681}#) + #{n\ 3682}# + #{ids\ 3683}#)) + (lambda (#{y\ 3687}# #{ids\ 3688}#) (call-with-values (lambda () - (#{cvt\ 3686}# - (car #{p*\ 3687}#) - #{n\ 3688}# - #{ids\ 3694}#)) - (lambda (#{x\ 3697}# #{ids\ 3698}#) + (#{cvt\ 3680}# + (car #{p*\ 3681}#) + #{n\ 3682}# + #{ids\ 3688}#)) + (lambda (#{x\ 3691}# #{ids\ 3692}#) (values - (cons #{x\ 3697}# #{y\ 3693}#) - #{ids\ 3698}#)))))))) - (#{cvt\ 3686}# - (lambda (#{p\ 3701}# #{n\ 3702}# #{ids\ 3703}#) - (if (#{id?\ 379}# #{p\ 3701}#) - (if (#{bound-id-member?\ 443}# - #{p\ 3701}# - #{keys\ 3680}#) + (cons #{x\ 3691}# #{y\ 3687}#) + #{ids\ 3692}#)))))))) + (#{cvt\ 3680}# + (lambda (#{p\ 3695}# #{n\ 3696}# #{ids\ 3697}#) + (if (#{id?\ 380}# #{p\ 3695}#) + (if (#{bound-id-member?\ 444}# + #{p\ 3695}# + #{keys\ 3674}#) (values - (vector 'free-id #{p\ 3701}#) - #{ids\ 3703}#) - (if (#{free-id=?\ 435}# - #{p\ 3701}# + (vector 'free-id #{p\ 3695}#) + #{ids\ 3697}#) + (if (#{free-id=?\ 436}# + #{p\ 3695}# '#(syntax-object _ ((top) @@ -11805,22 +11830,22 @@ #(ribcage #(p n ids) #((top) (top) (top)) - #("i3704" "i3705" "i3706")) + #("i3698" "i3699" "i3700")) #(ribcage (cvt cvt*) ((top) (top)) - ("i3685" "i3683")) + ("i3679" "i3677")) #(ribcage #(pattern keys) #((top) (top)) - #("i3681" "i3682")) + #("i3675" "i3676")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) - ("i3677" "i3675" "i3673" "i3671")) + ("i3671" "i3669" "i3667" "i3665")) #(ribcage (lambda-var-list gen-var @@ -11838,7 +11863,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -12094,60 +12118,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -12156,407 +12179,406 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) - (values '_ #{ids\ 3703}#) + (values '_ #{ids\ 3697}#) (values 'any - (cons (cons #{p\ 3701}# #{n\ 3702}#) - #{ids\ 3703}#)))) - (let ((#{tmp\ 3712}# #{p\ 3701}#)) - (let ((#{tmp\ 3713}# + (cons (cons #{p\ 3695}# #{n\ 3696}#) + #{ids\ 3697}#)))) + (let ((#{tmp\ 3706}# #{p\ 3695}#)) + (let ((#{tmp\ 3707}# ($sc-dispatch - #{tmp\ 3712}# + #{tmp\ 3706}# '(any any)))) - (if (if #{tmp\ 3713}# + (if (if #{tmp\ 3707}# (@apply - (lambda (#{x\ 3716}# #{dots\ 3717}#) - (#{ellipsis?\ 477}# - #{dots\ 3717}#)) - #{tmp\ 3713}#) + (lambda (#{x\ 3710}# #{dots\ 3711}#) + (#{ellipsis?\ 476}# + #{dots\ 3711}#)) + #{tmp\ 3707}#) #f) (@apply - (lambda (#{x\ 3720}# #{dots\ 3721}#) + (lambda (#{x\ 3714}# #{dots\ 3715}#) (call-with-values (lambda () - (#{cvt\ 3686}# - #{x\ 3720}# - (#{fx+\ 282}# #{n\ 3702}# 1) - #{ids\ 3703}#)) - (lambda (#{p\ 3722}# #{ids\ 3723}#) + (#{cvt\ 3680}# + #{x\ 3714}# + (#{fx+\ 283}# #{n\ 3696}# 1) + #{ids\ 3697}#)) + (lambda (#{p\ 3716}# #{ids\ 3717}#) (values - (if (eq? #{p\ 3722}# 'any) + (if (eq? #{p\ 3716}# 'any) 'each-any - (vector 'each #{p\ 3722}#)) - #{ids\ 3723}#)))) - #{tmp\ 3713}#) - (let ((#{tmp\ 3726}# + (vector 'each #{p\ 3716}#)) + #{ids\ 3717}#)))) + #{tmp\ 3707}#) + (let ((#{tmp\ 3720}# ($sc-dispatch - #{tmp\ 3712}# + #{tmp\ 3706}# '(any any . each-any)))) - (if (if #{tmp\ 3726}# + (if (if #{tmp\ 3720}# (@apply - (lambda (#{x\ 3730}# - #{dots\ 3731}# - #{ys\ 3732}#) - (#{ellipsis?\ 477}# - #{dots\ 3731}#)) - #{tmp\ 3726}#) + (lambda (#{x\ 3724}# + #{dots\ 3725}# + #{ys\ 3726}#) + (#{ellipsis?\ 476}# + #{dots\ 3725}#)) + #{tmp\ 3720}#) #f) (@apply - (lambda (#{x\ 3736}# - #{dots\ 3737}# - #{ys\ 3738}#) + (lambda (#{x\ 3730}# + #{dots\ 3731}# + #{ys\ 3732}#) (call-with-values (lambda () - (#{cvt*\ 3684}# - #{ys\ 3738}# - #{n\ 3702}# - #{ids\ 3703}#)) - (lambda (#{ys\ 3740}# - #{ids\ 3741}#) + (#{cvt*\ 3678}# + #{ys\ 3732}# + #{n\ 3696}# + #{ids\ 3697}#)) + (lambda (#{ys\ 3734}# + #{ids\ 3735}#) (call-with-values (lambda () - (#{cvt\ 3686}# - #{x\ 3736}# - (1+ #{n\ 3702}#) - #{ids\ 3741}#)) - (lambda (#{x\ 3744}# - #{ids\ 3745}#) + (#{cvt\ 3680}# + #{x\ 3730}# + (1+ #{n\ 3696}#) + #{ids\ 3735}#)) + (lambda (#{x\ 3738}# + #{ids\ 3739}#) (values (vector 'each+ - #{x\ 3744}# - (reverse #{ys\ 3740}#) + #{x\ 3738}# + (reverse #{ys\ 3734}#) '()) - #{ids\ 3745}#)))))) - #{tmp\ 3726}#) - (let ((#{tmp\ 3749}# + #{ids\ 3739}#)))))) + #{tmp\ 3720}#) + (let ((#{tmp\ 3743}# ($sc-dispatch - #{tmp\ 3712}# + #{tmp\ 3706}# '(any . any)))) - (if #{tmp\ 3749}# + (if #{tmp\ 3743}# (@apply - (lambda (#{x\ 3752}# #{y\ 3753}#) + (lambda (#{x\ 3746}# #{y\ 3747}#) (call-with-values (lambda () - (#{cvt\ 3686}# - #{y\ 3753}# - #{n\ 3702}# - #{ids\ 3703}#)) - (lambda (#{y\ 3754}# - #{ids\ 3755}#) + (#{cvt\ 3680}# + #{y\ 3747}# + #{n\ 3696}# + #{ids\ 3697}#)) + (lambda (#{y\ 3748}# + #{ids\ 3749}#) (call-with-values (lambda () - (#{cvt\ 3686}# - #{x\ 3752}# - #{n\ 3702}# - #{ids\ 3755}#)) - (lambda (#{x\ 3758}# - #{ids\ 3759}#) + (#{cvt\ 3680}# + #{x\ 3746}# + #{n\ 3696}# + #{ids\ 3749}#)) + (lambda (#{x\ 3752}# + #{ids\ 3753}#) (values - (cons #{x\ 3758}# - #{y\ 3754}#) - #{ids\ 3759}#)))))) - #{tmp\ 3749}#) - (let ((#{tmp\ 3762}# + (cons #{x\ 3752}# + #{y\ 3748}#) + #{ids\ 3753}#)))))) + #{tmp\ 3743}#) + (let ((#{tmp\ 3756}# ($sc-dispatch - #{tmp\ 3712}# + #{tmp\ 3706}# '()))) - (if #{tmp\ 3762}# + (if #{tmp\ 3756}# (@apply (lambda () - (values '() #{ids\ 3703}#)) - #{tmp\ 3762}#) - (let ((#{tmp\ 3763}# + (values '() #{ids\ 3697}#)) + #{tmp\ 3756}#) + (let ((#{tmp\ 3757}# ($sc-dispatch - #{tmp\ 3712}# + #{tmp\ 3706}# '#(vector each-any)))) - (if #{tmp\ 3763}# + (if #{tmp\ 3757}# (@apply - (lambda (#{x\ 3765}#) + (lambda (#{x\ 3759}#) (call-with-values (lambda () - (#{cvt\ 3686}# - #{x\ 3765}# - #{n\ 3702}# - #{ids\ 3703}#)) - (lambda (#{p\ 3767}# - #{ids\ 3768}#) + (#{cvt\ 3680}# + #{x\ 3759}# + #{n\ 3696}# + #{ids\ 3697}#)) + (lambda (#{p\ 3761}# + #{ids\ 3762}#) (values (vector 'vector - #{p\ 3767}#) - #{ids\ 3768}#)))) - #{tmp\ 3763}#) - (let ((#{x\ 3772}# - #{tmp\ 3712}#)) + #{p\ 3761}#) + #{ids\ 3762}#)))) + #{tmp\ 3757}#) + (let ((#{x\ 3766}# + #{tmp\ 3706}#)) (values (vector 'atom - (#{strip\ 487}# - #{p\ 3701}# + (#{strip\ 486}# + #{p\ 3695}# '(()))) - #{ids\ 3703}#))))))))))))))))) - (begin (#{cvt\ 3686}# #{pattern\ 3679}# 0 '()))))) - (#{build-dispatch-call\ 3674}# - (lambda (#{pvars\ 3774}# - #{exp\ 3775}# - #{y\ 3776}# - #{r\ 3777}# - #{mod\ 3778}#) + #{ids\ 3697}#))))))))))))))))) + (begin (#{cvt\ 3680}# #{pattern\ 3673}# 0 '()))))) + (#{build-dispatch-call\ 3668}# + (lambda (#{pvars\ 3768}# + #{exp\ 3769}# + #{y\ 3770}# + #{r\ 3771}# + #{mod\ 3772}#) (begin - (map cdr #{pvars\ 3774}#) - (let ((#{ids\ 3786}# (map car #{pvars\ 3774}#))) + (map cdr #{pvars\ 3768}#) + (let ((#{ids\ 3780}# (map car #{pvars\ 3768}#))) (begin - (let ((#{labels\ 3790}# - (#{gen-labels\ 394}# #{ids\ 3786}#)) - (#{new-vars\ 3791}# - (map #{gen-var\ 489}# #{ids\ 3786}#))) - (#{build-application\ 305}# + (let ((#{labels\ 3784}# + (#{gen-labels\ 395}# #{ids\ 3780}#)) + (#{new-vars\ 3785}# + (map #{gen-var\ 488}# #{ids\ 3780}#))) + (#{build-application\ 306}# #f - (#{build-primref\ 329}# #f 'apply) - (list (#{build-simple-lambda\ 323}# + (#{build-primref\ 330}# #f 'apply) + (list (#{build-simple-lambda\ 324}# #f - (map syntax->datum #{ids\ 3786}#) + (map syntax->datum #{ids\ 3780}#) #f - #{new-vars\ 3791}# + #{new-vars\ 3785}# '() - (#{chi\ 461}# - #{exp\ 3775}# - (#{extend-env\ 367}# - #{labels\ 3790}# - (map (lambda (#{var\ 3795}# - #{level\ 3796}#) + (#{chi\ 460}# + #{exp\ 3769}# + (#{extend-env\ 368}# + #{labels\ 3784}# + (map (lambda (#{var\ 3789}# + #{level\ 3790}#) (cons 'syntax - (cons #{var\ 3795}# - #{level\ 3796}#))) - #{new-vars\ 3791}# - (map cdr #{pvars\ 3774}#)) - #{r\ 3777}#) - (#{make-binding-wrap\ 423}# - #{ids\ 3786}# - #{labels\ 3790}# + (cons #{var\ 3789}# + #{level\ 3790}#))) + #{new-vars\ 3785}# + (map cdr #{pvars\ 3768}#)) + #{r\ 3771}#) + (#{make-binding-wrap\ 424}# + #{ids\ 3780}# + #{labels\ 3784}# '(())) - #{mod\ 3778}#)) - #{y\ 3776}#)))))))) - (#{gen-clause\ 3676}# - (lambda (#{x\ 3802}# - #{keys\ 3803}# - #{clauses\ 3804}# - #{r\ 3805}# - #{pat\ 3806}# - #{fender\ 3807}# - #{exp\ 3808}# - #{mod\ 3809}#) + #{mod\ 3772}#)) + #{y\ 3770}#)))))))) + (#{gen-clause\ 3670}# + (lambda (#{x\ 3796}# + #{keys\ 3797}# + #{clauses\ 3798}# + #{r\ 3799}# + #{pat\ 3800}# + #{fender\ 3801}# + #{exp\ 3802}# + #{mod\ 3803}#) (call-with-values (lambda () - (#{convert-pattern\ 3672}# - #{pat\ 3806}# - #{keys\ 3803}#)) - (lambda (#{p\ 3818}# #{pvars\ 3819}#) - (if (not (#{distinct-bound-ids?\ 441}# - (map car #{pvars\ 3819}#))) + (#{convert-pattern\ 3666}# + #{pat\ 3800}# + #{keys\ 3797}#)) + (lambda (#{p\ 3812}# #{pvars\ 3813}#) + (if (not (#{distinct-bound-ids?\ 442}# + (map car #{pvars\ 3813}#))) (syntax-violation 'syntax-case "duplicate pattern variable" - #{pat\ 3806}#) + #{pat\ 3800}#) (if (not (and-map - (lambda (#{x\ 3826}#) - (not (#{ellipsis?\ 477}# - (car #{x\ 3826}#)))) - #{pvars\ 3819}#)) + (lambda (#{x\ 3820}#) + (not (#{ellipsis?\ 476}# + (car #{x\ 3820}#)))) + #{pvars\ 3813}#)) (syntax-violation 'syntax-case "misplaced ellipsis" - #{pat\ 3806}#) + #{pat\ 3800}#) (begin - (let ((#{y\ 3830}# (#{gen-var\ 489}# 'tmp))) - (#{build-application\ 305}# + (let ((#{y\ 3824}# (#{gen-var\ 488}# 'tmp))) + (#{build-application\ 306}# #f - (#{build-simple-lambda\ 323}# + (#{build-simple-lambda\ 324}# #f (list 'tmp) #f - (list #{y\ 3830}#) + (list #{y\ 3824}#) '() (begin - (let ((#{y\ 3834}# - (#{build-lexical-reference\ 311}# + (let ((#{y\ 3828}# + (#{build-lexical-reference\ 312}# 'value #f 'tmp - #{y\ 3830}#))) - (#{build-conditional\ 307}# + #{y\ 3824}#))) + (#{build-conditional\ 308}# #f - (let ((#{tmp\ 3837}# - #{fender\ 3807}#)) - (let ((#{tmp\ 3838}# + (let ((#{tmp\ 3831}# + #{fender\ 3801}#)) + (let ((#{tmp\ 3832}# ($sc-dispatch - #{tmp\ 3837}# + #{tmp\ 3831}# '#(atom #t)))) - (if #{tmp\ 3838}# + (if #{tmp\ 3832}# (@apply - (lambda () #{y\ 3834}#) - #{tmp\ 3838}#) - (let ((#{_\ 3840}# - #{tmp\ 3837}#)) - (#{build-conditional\ 307}# + (lambda () #{y\ 3828}#) + #{tmp\ 3832}#) + (let ((#{_\ 3834}# + #{tmp\ 3831}#)) + (#{build-conditional\ 308}# #f - #{y\ 3834}# - (#{build-dispatch-call\ 3674}# - #{pvars\ 3819}# - #{fender\ 3807}# - #{y\ 3834}# - #{r\ 3805}# - #{mod\ 3809}#) - (#{build-data\ 331}# + #{y\ 3828}# + (#{build-dispatch-call\ 3668}# + #{pvars\ 3813}# + #{fender\ 3801}# + #{y\ 3828}# + #{r\ 3799}# + #{mod\ 3803}#) + (#{build-data\ 332}# #f #f)))))) - (#{build-dispatch-call\ 3674}# - #{pvars\ 3819}# - #{exp\ 3808}# - #{y\ 3834}# - #{r\ 3805}# - #{mod\ 3809}#) - (#{gen-syntax-case\ 3678}# - #{x\ 3802}# - #{keys\ 3803}# - #{clauses\ 3804}# - #{r\ 3805}# - #{mod\ 3809}#))))) - (list (if (eq? #{p\ 3818}# 'any) - (#{build-application\ 305}# + (#{build-dispatch-call\ 3668}# + #{pvars\ 3813}# + #{exp\ 3802}# + #{y\ 3828}# + #{r\ 3799}# + #{mod\ 3803}#) + (#{gen-syntax-case\ 3672}# + #{x\ 3796}# + #{keys\ 3797}# + #{clauses\ 3798}# + #{r\ 3799}# + #{mod\ 3803}#))))) + (list (if (eq? #{p\ 3812}# 'any) + (#{build-application\ 306}# #f - (#{build-primref\ 329}# #f 'list) - (list #{x\ 3802}#)) - (#{build-application\ 305}# + (#{build-primref\ 330}# #f 'list) + (list #{x\ 3796}#)) + (#{build-application\ 306}# #f - (#{build-primref\ 329}# + (#{build-primref\ 330}# #f '$sc-dispatch) - (list #{x\ 3802}# - (#{build-data\ 331}# + (list #{x\ 3796}# + (#{build-data\ 332}# #f - #{p\ 3818}#)))))))))))))) - (#{gen-syntax-case\ 3678}# - (lambda (#{x\ 3848}# - #{keys\ 3849}# - #{clauses\ 3850}# - #{r\ 3851}# - #{mod\ 3852}#) - (if (null? #{clauses\ 3850}#) - (#{build-application\ 305}# + #{p\ 3812}#)))))))))))))) + (#{gen-syntax-case\ 3672}# + (lambda (#{x\ 3842}# + #{keys\ 3843}# + #{clauses\ 3844}# + #{r\ 3845}# + #{mod\ 3846}#) + (if (null? #{clauses\ 3844}#) + (#{build-application\ 306}# #f - (#{build-primref\ 329}# #f 'syntax-violation) - (list (#{build-data\ 331}# #f #f) - (#{build-data\ 331}# + (#{build-primref\ 330}# #f 'syntax-violation) + (list (#{build-data\ 332}# #f #f) + (#{build-data\ 332}# #f "source expression failed to match any pattern") - #{x\ 3848}#)) - (let ((#{tmp\ 3862}# (car #{clauses\ 3850}#))) - (let ((#{tmp\ 3863}# - ($sc-dispatch #{tmp\ 3862}# '(any any)))) - (if #{tmp\ 3863}# + #{x\ 3842}#)) + (let ((#{tmp\ 3856}# (car #{clauses\ 3844}#))) + (let ((#{tmp\ 3857}# + ($sc-dispatch #{tmp\ 3856}# '(any any)))) + (if #{tmp\ 3857}# (@apply - (lambda (#{pat\ 3866}# #{exp\ 3867}#) - (if (if (#{id?\ 379}# #{pat\ 3866}#) + (lambda (#{pat\ 3860}# #{exp\ 3861}#) + (if (if (#{id?\ 380}# #{pat\ 3860}#) (and-map - (lambda (#{x\ 3870}#) - (not (#{free-id=?\ 435}# - #{pat\ 3866}# - #{x\ 3870}#))) + (lambda (#{x\ 3864}#) + (not (#{free-id=?\ 436}# + #{pat\ 3860}# + #{x\ 3864}#))) (cons '#(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) - #("i3864" "i3865")) + #("i3858" "i3859")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) @@ -12565,21 +12587,21 @@ (top) (top) (top)) - #("i3853" - "i3854" - "i3855" - "i3856" - "i3857")) + #("i3847" + "i3848" + "i3849" + "i3850" + "i3851")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) - ("i3677" - "i3675" - "i3673" - "i3671")) + ("i3671" + "i3669" + "i3667" + "i3665")) #(ribcage (lambda-var-list gen-var @@ -12597,7 +12619,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -12853,60 +12874,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -12915,123 +12935,122 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" + ("i41" + "i40" "i39" - "i38" - "i36"))) + "i37"))) (hygiene guile)) - #{keys\ 3849}#)) + #{keys\ 3843}#)) #f) - (if (#{free-id=?\ 435}# + (if (#{free-id=?\ 436}# '#(syntax-object pad ((top) #(ribcage #(pat exp) #((top) (top)) - #("i3864" "i3865")) + #("i3858" "i3859")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) - #("i3853" - "i3854" - "i3855" - "i3856" - "i3857")) + #("i3847" + "i3848" + "i3849" + "i3850" + "i3851")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) - ("i3677" - "i3675" - "i3673" - "i3671")) + ("i3671" + "i3669" + "i3667" + "i3665")) #(ribcage (lambda-var-list gen-var @@ -13049,7 +13068,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -13305,60 +13323,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -13367,90 +13384,89 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile)) '#(syntax-object _ @@ -13458,26 +13474,26 @@ #(ribcage #(pat exp) #((top) (top)) - #("i3864" "i3865")) + #("i3858" "i3859")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) - #("i3853" - "i3854" - "i3855" - "i3856" - "i3857")) + #("i3847" + "i3848" + "i3849" + "i3850" + "i3851")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) - ("i3677" - "i3675" - "i3673" - "i3671")) + ("i3671" + "i3669" + "i3667" + "i3665")) #(ribcage (lambda-var-list gen-var @@ -13495,7 +13511,6 @@ chi-application chi-expr chi - chi-top syntax-type chi-when-list chi-install-global @@ -13751,60 +13766,59 @@ (top) (top) (top) - (top) (top)) - ("i490" - "i488" - "i486" - "i484" - "i482" - "i480" - "i478" - "i476" - "i474" - "i472" - "i470" - "i468" - "i466" - "i464" - "i462" - "i460" - "i458" - "i456" - "i454" - "i452" - "i450" - "i448" - "i446" - "i444" - "i442" - "i440" - "i438" - "i436" - "i434" - "i432" - "i430" - "i428" - "i426" - "i424" - "i422" + ("i489" + "i487" + "i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" "i420" "i419" - "i418" + "i417" "i416" "i415" "i414" "i413" - "i412" - "i410" - "i408" - "i406" - "i404" - "i402" - "i400" - "i398" - "i396" - "i393" + "i411" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i394" + "i392" "i391" "i390" "i389" @@ -13813,676 +13827,676 @@ "i386" "i385" "i384" - "i383" + "i382" "i381" - "i380" - "i378" - "i376" - "i374" - "i372" - "i370" - "i368" + "i379" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" "i366" "i365" "i364" "i363" "i362" - "i361" + "i360" "i359" - "i358" - "i356" - "i354" - "i352" - "i350" - "i348" - "i346" - "i344" - "i342" - "i340" - "i338" - "i336" - "i334" - "i332" - "i330" - "i328" - "i326" - "i324" - "i322" - "i320" - "i318" - "i316" - "i314" - "i312" - "i310" - "i308" - "i306" - "i304" - "i302" - "i300" - "i298" - "i296" + "i357" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" "i294" - "i293" - "i291" - "i289" - "i287" - "i285" - "i283" - "i281" - "i279" - "i277" - "i275" - "i272" - "i270" - "i268" - "i266" - "i264" - "i262" - "i260" - "i258" - "i256" - "i254" - "i252" - "i250" - "i248" - "i246" - "i244" - "i242" - "i240" - "i238")) + "i292" + "i290" + "i288" + "i286" + "i284" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) #(ribcage (define-structure define-expansion-accessors define-expansion-constructors and-map*) ((top) (top) (top) (top)) - ("i40" "i39" "i38" "i36"))) + ("i41" "i40" "i39" "i37"))) (hygiene guile))) - (#{chi\ 461}# - #{exp\ 3867}# - #{r\ 3851}# + (#{chi\ 460}# + #{exp\ 3861}# + #{r\ 3845}# '(()) - #{mod\ 3852}#) + #{mod\ 3846}#) (begin - (let ((#{labels\ 3875}# - (list (#{gen-label\ 392}#))) - (#{var\ 3876}# - (#{gen-var\ 489}# - #{pat\ 3866}#))) - (#{build-application\ 305}# + (let ((#{labels\ 3869}# + (list (#{gen-label\ 393}#))) + (#{var\ 3870}# + (#{gen-var\ 488}# + #{pat\ 3860}#))) + (#{build-application\ 306}# #f - (#{build-simple-lambda\ 323}# + (#{build-simple-lambda\ 324}# #f (list (syntax->datum - #{pat\ 3866}#)) + #{pat\ 3860}#)) #f - (list #{var\ 3876}#) + (list #{var\ 3870}#) '() - (#{chi\ 461}# - #{exp\ 3867}# - (#{extend-env\ 367}# - #{labels\ 3875}# + (#{chi\ 460}# + #{exp\ 3861}# + (#{extend-env\ 368}# + #{labels\ 3869}# (list (cons 'syntax - (cons #{var\ 3876}# + (cons #{var\ 3870}# 0))) - #{r\ 3851}#) - (#{make-binding-wrap\ 423}# - (list #{pat\ 3866}#) - #{labels\ 3875}# + #{r\ 3845}#) + (#{make-binding-wrap\ 424}# + (list #{pat\ 3860}#) + #{labels\ 3869}# '(())) - #{mod\ 3852}#)) - (list #{x\ 3848}#))))) - (#{gen-clause\ 3676}# - #{x\ 3848}# - #{keys\ 3849}# - (cdr #{clauses\ 3850}#) - #{r\ 3851}# - #{pat\ 3866}# + #{mod\ 3846}#)) + (list #{x\ 3842}#))))) + (#{gen-clause\ 3670}# + #{x\ 3842}# + #{keys\ 3843}# + (cdr #{clauses\ 3844}#) + #{r\ 3845}# + #{pat\ 3860}# #t - #{exp\ 3867}# - #{mod\ 3852}#))) - #{tmp\ 3863}#) - (let ((#{tmp\ 3882}# + #{exp\ 3861}# + #{mod\ 3846}#))) + #{tmp\ 3857}#) + (let ((#{tmp\ 3876}# ($sc-dispatch - #{tmp\ 3862}# + #{tmp\ 3856}# '(any any any)))) - (if #{tmp\ 3882}# + (if #{tmp\ 3876}# (@apply - (lambda (#{pat\ 3886}# - #{fender\ 3887}# - #{exp\ 3888}#) - (#{gen-clause\ 3676}# - #{x\ 3848}# - #{keys\ 3849}# - (cdr #{clauses\ 3850}#) - #{r\ 3851}# - #{pat\ 3886}# - #{fender\ 3887}# - #{exp\ 3888}# - #{mod\ 3852}#)) - #{tmp\ 3882}#) - (let ((#{_\ 3890}# #{tmp\ 3862}#)) + (lambda (#{pat\ 3880}# + #{fender\ 3881}# + #{exp\ 3882}#) + (#{gen-clause\ 3670}# + #{x\ 3842}# + #{keys\ 3843}# + (cdr #{clauses\ 3844}#) + #{r\ 3845}# + #{pat\ 3880}# + #{fender\ 3881}# + #{exp\ 3882}# + #{mod\ 3846}#)) + #{tmp\ 3876}#) + (let ((#{_\ 3884}# #{tmp\ 3856}#)) (syntax-violation 'syntax-case "invalid clause" - (car #{clauses\ 3850}#)))))))))))) + (car #{clauses\ 3844}#)))))))))))) (begin - (lambda (#{e\ 3891}# - #{r\ 3892}# - #{w\ 3893}# - #{s\ 3894}# - #{mod\ 3895}#) + (lambda (#{e\ 3885}# + #{r\ 3886}# + #{w\ 3887}# + #{s\ 3888}# + #{mod\ 3889}#) (begin - (let ((#{e\ 3902}# - (#{source-wrap\ 447}# - #{e\ 3891}# - #{w\ 3893}# - #{s\ 3894}# - #{mod\ 3895}#))) - (let ((#{tmp\ 3903}# #{e\ 3902}#)) - (let ((#{tmp\ 3904}# + (let ((#{e\ 3896}# + (#{source-wrap\ 448}# + #{e\ 3885}# + #{w\ 3887}# + #{s\ 3888}# + #{mod\ 3889}#))) + (let ((#{tmp\ 3897}# #{e\ 3896}#)) + (let ((#{tmp\ 3898}# ($sc-dispatch - #{tmp\ 3903}# + #{tmp\ 3897}# '(_ any each-any . each-any)))) - (if #{tmp\ 3904}# + (if #{tmp\ 3898}# (@apply - (lambda (#{val\ 3908}# - #{key\ 3909}# - #{m\ 3910}#) + (lambda (#{val\ 3902}# + #{key\ 3903}# + #{m\ 3904}#) (if (and-map - (lambda (#{x\ 3911}#) - (if (#{id?\ 379}# #{x\ 3911}#) - (not (#{ellipsis?\ 477}# - #{x\ 3911}#)) + (lambda (#{x\ 3905}#) + (if (#{id?\ 380}# #{x\ 3905}#) + (not (#{ellipsis?\ 476}# + #{x\ 3905}#)) #f)) - #{key\ 3909}#) + #{key\ 3903}#) (begin - (let ((#{x\ 3917}# - (#{gen-var\ 489}# 'tmp))) - (#{build-application\ 305}# - #{s\ 3894}# - (#{build-simple-lambda\ 323}# + (let ((#{x\ 3911}# + (#{gen-var\ 488}# 'tmp))) + (#{build-application\ 306}# + #{s\ 3888}# + (#{build-simple-lambda\ 324}# #f (list 'tmp) #f - (list #{x\ 3917}#) + (list #{x\ 3911}#) '() - (#{gen-syntax-case\ 3678}# - (#{build-lexical-reference\ 311}# + (#{gen-syntax-case\ 3672}# + (#{build-lexical-reference\ 312}# 'value #f 'tmp - #{x\ 3917}#) - #{key\ 3909}# - #{m\ 3910}# - #{r\ 3892}# - #{mod\ 3895}#)) - (list (#{chi\ 461}# - #{val\ 3908}# - #{r\ 3892}# + #{x\ 3911}#) + #{key\ 3903}# + #{m\ 3904}# + #{r\ 3886}# + #{mod\ 3889}#)) + (list (#{chi\ 460}# + #{val\ 3902}# + #{r\ 3886}# '(()) - #{mod\ 3895}#))))) + #{mod\ 3889}#))))) (syntax-violation 'syntax-case "invalid literals list" - #{e\ 3902}#))) - #{tmp\ 3904}#) + #{e\ 3896}#))) + #{tmp\ 3898}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3903}#)))))))))) + #{tmp\ 3897}#)))))))))) (set! macroexpand (lambda* - (#{x\ 3923}# + (#{x\ 3917}# #:optional - (#{m\ 3925}# 'e) - (#{esew\ 3927}# '(eval))) - (#{chi-top\ 459}# - #{x\ 3923}# + (#{m\ 3919}# 'e) + (#{esew\ 3921}# '(eval))) + (#{chi-top-sequence\ 452}# + (list #{x\ 3917}#) '() '((top)) - #{m\ 3925}# - #{esew\ 3927}# + #f + #{m\ 3919}# + #{esew\ 3921}# (cons 'hygiene (module-name (current-module)))))) (set! identifier? - (lambda (#{x\ 3931}#) - (#{nonsymbol-id?\ 377}# #{x\ 3931}#))) + (lambda (#{x\ 3925}#) + (#{nonsymbol-id?\ 378}# #{x\ 3925}#))) (set! datum->syntax - (lambda (#{id\ 3933}# #{datum\ 3934}#) - (#{make-syntax-object\ 343}# - #{datum\ 3934}# - (#{syntax-object-wrap\ 349}# #{id\ 3933}#) - (#{syntax-object-module\ 351}# #{id\ 3933}#)))) + (lambda (#{id\ 3927}# #{datum\ 3928}#) + (#{make-syntax-object\ 344}# + #{datum\ 3928}# + (#{syntax-object-wrap\ 350}# #{id\ 3927}#) + (#{syntax-object-module\ 352}# #{id\ 3927}#)))) (set! syntax->datum - (lambda (#{x\ 3937}#) - (#{strip\ 487}# #{x\ 3937}# '(())))) + (lambda (#{x\ 3931}#) + (#{strip\ 486}# #{x\ 3931}# '(())))) (set! syntax-source - (lambda (#{x\ 3940}#) - (#{source-annotation\ 360}# #{x\ 3940}#))) + (lambda (#{x\ 3934}#) + (#{source-annotation\ 361}# #{x\ 3934}#))) (set! generate-temporaries - (lambda (#{ls\ 3942}#) + (lambda (#{ls\ 3936}#) (begin (begin - (let ((#{x\ 3946}# #{ls\ 3942}#)) - (if (not (list? #{x\ 3946}#)) + (let ((#{x\ 3940}# #{ls\ 3936}#)) + (if (not (list? #{x\ 3940}#)) (syntax-violation 'generate-temporaries "invalid argument" - #{x\ 3946}#)))) - (map (lambda (#{x\ 3947}#) - (#{wrap\ 445}# (gensym) '((top)) #f)) - #{ls\ 3942}#)))) + #{x\ 3940}#)))) + (map (lambda (#{x\ 3941}#) + (#{wrap\ 446}# (gensym) '((top)) #f)) + #{ls\ 3936}#)))) (set! free-identifier=? - (lambda (#{x\ 3951}# #{y\ 3952}#) + (lambda (#{x\ 3945}# #{y\ 3946}#) (begin (begin - (let ((#{x\ 3957}# #{x\ 3951}#)) - (if (not (#{nonsymbol-id?\ 377}# #{x\ 3957}#)) + (let ((#{x\ 3951}# #{x\ 3945}#)) + (if (not (#{nonsymbol-id?\ 378}# #{x\ 3951}#)) (syntax-violation 'free-identifier=? "invalid argument" - #{x\ 3957}#)))) + #{x\ 3951}#)))) (begin - (let ((#{x\ 3960}# #{y\ 3952}#)) - (if (not (#{nonsymbol-id?\ 377}# #{x\ 3960}#)) + (let ((#{x\ 3954}# #{y\ 3946}#)) + (if (not (#{nonsymbol-id?\ 378}# #{x\ 3954}#)) (syntax-violation 'free-identifier=? "invalid argument" - #{x\ 3960}#)))) - (#{free-id=?\ 435}# #{x\ 3951}# #{y\ 3952}#)))) + #{x\ 3954}#)))) + (#{free-id=?\ 436}# #{x\ 3945}# #{y\ 3946}#)))) (set! bound-identifier=? - (lambda (#{x\ 3961}# #{y\ 3962}#) + (lambda (#{x\ 3955}# #{y\ 3956}#) (begin (begin - (let ((#{x\ 3967}# #{x\ 3961}#)) - (if (not (#{nonsymbol-id?\ 377}# #{x\ 3967}#)) + (let ((#{x\ 3961}# #{x\ 3955}#)) + (if (not (#{nonsymbol-id?\ 378}# #{x\ 3961}#)) (syntax-violation 'bound-identifier=? "invalid argument" - #{x\ 3967}#)))) + #{x\ 3961}#)))) (begin - (let ((#{x\ 3970}# #{y\ 3962}#)) - (if (not (#{nonsymbol-id?\ 377}# #{x\ 3970}#)) + (let ((#{x\ 3964}# #{y\ 3956}#)) + (if (not (#{nonsymbol-id?\ 378}# #{x\ 3964}#)) (syntax-violation 'bound-identifier=? "invalid argument" - #{x\ 3970}#)))) - (#{bound-id=?\ 437}# #{x\ 3961}# #{y\ 3962}#)))) + #{x\ 3964}#)))) + (#{bound-id=?\ 438}# #{x\ 3955}# #{y\ 3956}#)))) (set! syntax-violation (lambda* - (#{who\ 3971}# - #{message\ 3972}# - #{form\ 3973}# + (#{who\ 3965}# + #{message\ 3966}# + #{form\ 3967}# #:optional - (#{subform\ 3977}# #f)) + (#{subform\ 3971}# #f)) (begin (begin - (let ((#{x\ 3981}# #{who\ 3971}#)) - (if (not (let ((#{x\ 3982}# #{x\ 3981}#)) + (let ((#{x\ 3975}# #{who\ 3965}#)) + (if (not (let ((#{x\ 3976}# #{x\ 3975}#)) (begin - (let ((#{t\ 3986}# (not #{x\ 3982}#))) - (if #{t\ 3986}# - #{t\ 3986}# + (let ((#{t\ 3980}# (not #{x\ 3976}#))) + (if #{t\ 3980}# + #{t\ 3980}# (begin - (let ((#{t\ 3989}# - (string? #{x\ 3982}#))) - (if #{t\ 3989}# - #{t\ 3989}# - (symbol? #{x\ 3982}#))))))))) + (let ((#{t\ 3983}# + (string? #{x\ 3976}#))) + (if #{t\ 3983}# + #{t\ 3983}# + (symbol? #{x\ 3976}#))))))))) (syntax-violation 'syntax-violation "invalid argument" - #{x\ 3981}#)))) + #{x\ 3975}#)))) (begin - (let ((#{x\ 3993}# #{message\ 3972}#)) - (if (not (string? #{x\ 3993}#)) + (let ((#{x\ 3987}# #{message\ 3966}#)) + (if (not (string? #{x\ 3987}#)) (syntax-violation 'syntax-violation "invalid argument" - #{x\ 3993}#)))) + #{x\ 3987}#)))) (throw 'syntax-error - #{who\ 3971}# - #{message\ 3972}# - (#{source-annotation\ 360}# + #{who\ 3965}# + #{message\ 3966}# + (#{source-annotation\ 361}# (begin - (let ((#{t\ 3996}# #{form\ 3973}#)) - (if #{t\ 3996}# - #{t\ 3996}# - #{subform\ 3977}#)))) - (#{strip\ 487}# #{form\ 3973}# '(())) - (if #{subform\ 3977}# - (#{strip\ 487}# #{subform\ 3977}# '(())) + (let ((#{t\ 3990}# #{form\ 3967}#)) + (if #{t\ 3990}# + #{t\ 3990}# + #{subform\ 3971}#)))) + (#{strip\ 486}# #{form\ 3967}# '(())) + (if #{subform\ 3971}# + (#{strip\ 486}# #{subform\ 3971}# '(())) #f))))) (letrec* - ((#{match-each\ 4003}# - (lambda (#{e\ 4016}# - #{p\ 4017}# - #{w\ 4018}# - #{mod\ 4019}#) - (if (pair? #{e\ 4016}#) + ((#{match-each\ 3997}# + (lambda (#{e\ 4010}# + #{p\ 4011}# + #{w\ 4012}# + #{mod\ 4013}#) + (if (pair? #{e\ 4010}#) (begin - (let ((#{first\ 4027}# - (#{match\ 4015}# - (car #{e\ 4016}#) - #{p\ 4017}# - #{w\ 4018}# + (let ((#{first\ 4021}# + (#{match\ 4009}# + (car #{e\ 4010}#) + #{p\ 4011}# + #{w\ 4012}# '() - #{mod\ 4019}#))) - (if #{first\ 4027}# + #{mod\ 4013}#))) + (if #{first\ 4021}# (begin - (let ((#{rest\ 4031}# - (#{match-each\ 4003}# - (cdr #{e\ 4016}#) - #{p\ 4017}# - #{w\ 4018}# - #{mod\ 4019}#))) - (if #{rest\ 4031}# - (cons #{first\ 4027}# #{rest\ 4031}#) + (let ((#{rest\ 4025}# + (#{match-each\ 3997}# + (cdr #{e\ 4010}#) + #{p\ 4011}# + #{w\ 4012}# + #{mod\ 4013}#))) + (if #{rest\ 4025}# + (cons #{first\ 4021}# #{rest\ 4025}#) #f))) #f))) - (if (null? #{e\ 4016}#) + (if (null? #{e\ 4010}#) '() - (if (#{syntax-object?\ 345}# #{e\ 4016}#) - (#{match-each\ 4003}# - (#{syntax-object-expression\ 347}# #{e\ 4016}#) - #{p\ 4017}# - (#{join-wraps\ 427}# - #{w\ 4018}# - (#{syntax-object-wrap\ 349}# #{e\ 4016}#)) - (#{syntax-object-module\ 351}# #{e\ 4016}#)) + (if (#{syntax-object?\ 346}# #{e\ 4010}#) + (#{match-each\ 3997}# + (#{syntax-object-expression\ 348}# #{e\ 4010}#) + #{p\ 4011}# + (#{join-wraps\ 428}# + #{w\ 4012}# + (#{syntax-object-wrap\ 350}# #{e\ 4010}#)) + (#{syntax-object-module\ 352}# #{e\ 4010}#)) #f))))) - (#{match-each+\ 4005}# - (lambda (#{e\ 4039}# - #{x-pat\ 4040}# - #{y-pat\ 4041}# - #{z-pat\ 4042}# - #{w\ 4043}# - #{r\ 4044}# - #{mod\ 4045}#) + (#{match-each+\ 3999}# + (lambda (#{e\ 4033}# + #{x-pat\ 4034}# + #{y-pat\ 4035}# + #{z-pat\ 4036}# + #{w\ 4037}# + #{r\ 4038}# + #{mod\ 4039}#) (letrec* - ((#{f\ 4056}# - (lambda (#{e\ 4057}# #{w\ 4058}#) - (if (pair? #{e\ 4057}#) + ((#{f\ 4050}# + (lambda (#{e\ 4051}# #{w\ 4052}#) + (if (pair? #{e\ 4051}#) (call-with-values (lambda () - (#{f\ 4056}# (cdr #{e\ 4057}#) #{w\ 4058}#)) - (lambda (#{xr*\ 4061}# - #{y-pat\ 4062}# - #{r\ 4063}#) - (if #{r\ 4063}# - (if (null? #{y-pat\ 4062}#) + (#{f\ 4050}# (cdr #{e\ 4051}#) #{w\ 4052}#)) + (lambda (#{xr*\ 4055}# + #{y-pat\ 4056}# + #{r\ 4057}#) + (if #{r\ 4057}# + (if (null? #{y-pat\ 4056}#) (begin - (let ((#{xr\ 4068}# - (#{match\ 4015}# - (car #{e\ 4057}#) - #{x-pat\ 4040}# - #{w\ 4058}# + (let ((#{xr\ 4062}# + (#{match\ 4009}# + (car #{e\ 4051}#) + #{x-pat\ 4034}# + #{w\ 4052}# '() - #{mod\ 4045}#))) - (if #{xr\ 4068}# + #{mod\ 4039}#))) + (if #{xr\ 4062}# (values - (cons #{xr\ 4068}# #{xr*\ 4061}#) - #{y-pat\ 4062}# - #{r\ 4063}#) + (cons #{xr\ 4062}# #{xr*\ 4055}#) + #{y-pat\ 4056}# + #{r\ 4057}#) (values #f #f #f)))) (values '() - (cdr #{y-pat\ 4062}#) - (#{match\ 4015}# - (car #{e\ 4057}#) - (car #{y-pat\ 4062}#) - #{w\ 4058}# - #{r\ 4063}# - #{mod\ 4045}#))) + (cdr #{y-pat\ 4056}#) + (#{match\ 4009}# + (car #{e\ 4051}#) + (car #{y-pat\ 4056}#) + #{w\ 4052}# + #{r\ 4057}# + #{mod\ 4039}#))) (values #f #f #f)))) - (if (#{syntax-object?\ 345}# #{e\ 4057}#) - (#{f\ 4056}# - (#{syntax-object-expression\ 347}# #{e\ 4057}#) - (#{join-wraps\ 427}# #{w\ 4058}# #{e\ 4057}#)) + (if (#{syntax-object?\ 346}# #{e\ 4051}#) + (#{f\ 4050}# + (#{syntax-object-expression\ 348}# #{e\ 4051}#) + (#{join-wraps\ 428}# #{w\ 4052}# #{e\ 4051}#)) (values '() - #{y-pat\ 4041}# - (#{match\ 4015}# - #{e\ 4057}# - #{z-pat\ 4042}# - #{w\ 4058}# - #{r\ 4044}# - #{mod\ 4045}#))))))) - (begin (#{f\ 4056}# #{e\ 4039}# #{w\ 4043}#))))) - (#{match-each-any\ 4007}# - (lambda (#{e\ 4072}# #{w\ 4073}# #{mod\ 4074}#) - (if (pair? #{e\ 4072}#) + #{y-pat\ 4035}# + (#{match\ 4009}# + #{e\ 4051}# + #{z-pat\ 4036}# + #{w\ 4052}# + #{r\ 4038}# + #{mod\ 4039}#))))))) + (begin (#{f\ 4050}# #{e\ 4033}# #{w\ 4037}#))))) + (#{match-each-any\ 4001}# + (lambda (#{e\ 4066}# #{w\ 4067}# #{mod\ 4068}#) + (if (pair? #{e\ 4066}#) (begin - (let ((#{l\ 4081}# - (#{match-each-any\ 4007}# - (cdr #{e\ 4072}#) - #{w\ 4073}# - #{mod\ 4074}#))) - (if #{l\ 4081}# - (cons (#{wrap\ 445}# - (car #{e\ 4072}#) - #{w\ 4073}# - #{mod\ 4074}#) - #{l\ 4081}#) + (let ((#{l\ 4075}# + (#{match-each-any\ 4001}# + (cdr #{e\ 4066}#) + #{w\ 4067}# + #{mod\ 4068}#))) + (if #{l\ 4075}# + (cons (#{wrap\ 446}# + (car #{e\ 4066}#) + #{w\ 4067}# + #{mod\ 4068}#) + #{l\ 4075}#) #f))) - (if (null? #{e\ 4072}#) + (if (null? #{e\ 4066}#) '() - (if (#{syntax-object?\ 345}# #{e\ 4072}#) - (#{match-each-any\ 4007}# - (#{syntax-object-expression\ 347}# #{e\ 4072}#) - (#{join-wraps\ 427}# - #{w\ 4073}# - (#{syntax-object-wrap\ 349}# #{e\ 4072}#)) - #{mod\ 4074}#) + (if (#{syntax-object?\ 346}# #{e\ 4066}#) + (#{match-each-any\ 4001}# + (#{syntax-object-expression\ 348}# #{e\ 4066}#) + (#{join-wraps\ 428}# + #{w\ 4067}# + (#{syntax-object-wrap\ 350}# #{e\ 4066}#)) + #{mod\ 4068}#) #f))))) - (#{match-empty\ 4009}# - (lambda (#{p\ 4089}# #{r\ 4090}#) - (if (null? #{p\ 4089}#) - #{r\ 4090}# - (if (eq? #{p\ 4089}# '_) - #{r\ 4090}# - (if (eq? #{p\ 4089}# 'any) - (cons '() #{r\ 4090}#) - (if (pair? #{p\ 4089}#) - (#{match-empty\ 4009}# - (car #{p\ 4089}#) - (#{match-empty\ 4009}# - (cdr #{p\ 4089}#) - #{r\ 4090}#)) - (if (eq? #{p\ 4089}# 'each-any) - (cons '() #{r\ 4090}#) + (#{match-empty\ 4003}# + (lambda (#{p\ 4083}# #{r\ 4084}#) + (if (null? #{p\ 4083}#) + #{r\ 4084}# + (if (eq? #{p\ 4083}# '_) + #{r\ 4084}# + (if (eq? #{p\ 4083}# 'any) + (cons '() #{r\ 4084}#) + (if (pair? #{p\ 4083}#) + (#{match-empty\ 4003}# + (car #{p\ 4083}#) + (#{match-empty\ 4003}# + (cdr #{p\ 4083}#) + #{r\ 4084}#)) + (if (eq? #{p\ 4083}# 'each-any) + (cons '() #{r\ 4084}#) (begin - (let ((#{atom-key\ 4106}# - (vector-ref #{p\ 4089}# 0))) - (if (eqv? #{atom-key\ 4106}# 'each) - (#{match-empty\ 4009}# - (vector-ref #{p\ 4089}# 1) - #{r\ 4090}#) - (if (eqv? #{atom-key\ 4106}# 'each+) - (#{match-empty\ 4009}# - (vector-ref #{p\ 4089}# 1) - (#{match-empty\ 4009}# - (reverse (vector-ref #{p\ 4089}# 2)) - (#{match-empty\ 4009}# - (vector-ref #{p\ 4089}# 3) - #{r\ 4090}#))) - (if (if (eqv? #{atom-key\ 4106}# 'free-id) + (let ((#{atom-key\ 4100}# + (vector-ref #{p\ 4083}# 0))) + (if (eqv? #{atom-key\ 4100}# 'each) + (#{match-empty\ 4003}# + (vector-ref #{p\ 4083}# 1) + #{r\ 4084}#) + (if (eqv? #{atom-key\ 4100}# 'each+) + (#{match-empty\ 4003}# + (vector-ref #{p\ 4083}# 1) + (#{match-empty\ 4003}# + (reverse (vector-ref #{p\ 4083}# 2)) + (#{match-empty\ 4003}# + (vector-ref #{p\ 4083}# 3) + #{r\ 4084}#))) + (if (if (eqv? #{atom-key\ 4100}# 'free-id) #t - (eqv? #{atom-key\ 4106}# 'atom)) - #{r\ 4090}# - (if (eqv? #{atom-key\ 4106}# 'vector) - (#{match-empty\ 4009}# - (vector-ref #{p\ 4089}# 1) - #{r\ 4090}#)))))))))))))) - (#{combine\ 4011}# - (lambda (#{r*\ 4111}# #{r\ 4112}#) - (if (null? (car #{r*\ 4111}#)) - #{r\ 4112}# - (cons (map car #{r*\ 4111}#) - (#{combine\ 4011}# - (map cdr #{r*\ 4111}#) - #{r\ 4112}#))))) - (#{match*\ 4013}# - (lambda (#{e\ 4115}# - #{p\ 4116}# - #{w\ 4117}# - #{r\ 4118}# - #{mod\ 4119}#) - (if (null? #{p\ 4116}#) - (if (null? #{e\ 4115}#) #{r\ 4118}# #f) - (if (pair? #{p\ 4116}#) - (if (pair? #{e\ 4115}#) - (#{match\ 4015}# - (car #{e\ 4115}#) - (car #{p\ 4116}#) - #{w\ 4117}# - (#{match\ 4015}# - (cdr #{e\ 4115}#) - (cdr #{p\ 4116}#) - #{w\ 4117}# - #{r\ 4118}# - #{mod\ 4119}#) - #{mod\ 4119}#) + (eqv? #{atom-key\ 4100}# 'atom)) + #{r\ 4084}# + (if (eqv? #{atom-key\ 4100}# 'vector) + (#{match-empty\ 4003}# + (vector-ref #{p\ 4083}# 1) + #{r\ 4084}#)))))))))))))) + (#{combine\ 4005}# + (lambda (#{r*\ 4105}# #{r\ 4106}#) + (if (null? (car #{r*\ 4105}#)) + #{r\ 4106}# + (cons (map car #{r*\ 4105}#) + (#{combine\ 4005}# + (map cdr #{r*\ 4105}#) + #{r\ 4106}#))))) + (#{match*\ 4007}# + (lambda (#{e\ 4109}# + #{p\ 4110}# + #{w\ 4111}# + #{r\ 4112}# + #{mod\ 4113}#) + (if (null? #{p\ 4110}#) + (if (null? #{e\ 4109}#) #{r\ 4112}# #f) + (if (pair? #{p\ 4110}#) + (if (pair? #{e\ 4109}#) + (#{match\ 4009}# + (car #{e\ 4109}#) + (car #{p\ 4110}#) + #{w\ 4111}# + (#{match\ 4009}# + (cdr #{e\ 4109}#) + (cdr #{p\ 4110}#) + #{w\ 4111}# + #{r\ 4112}# + #{mod\ 4113}#) + #{mod\ 4113}#) #f) - (if (eq? #{p\ 4116}# 'each-any) + (if (eq? #{p\ 4110}# 'each-any) (begin - (let ((#{l\ 4136}# - (#{match-each-any\ 4007}# - #{e\ 4115}# - #{w\ 4117}# - #{mod\ 4119}#))) - (if #{l\ 4136}# - (cons #{l\ 4136}# #{r\ 4118}#) + (let ((#{l\ 4130}# + (#{match-each-any\ 4001}# + #{e\ 4109}# + #{w\ 4111}# + #{mod\ 4113}#))) + (if #{l\ 4130}# + (cons #{l\ 4130}# #{r\ 4112}#) #f))) (begin - (let ((#{atom-key\ 4142}# - (vector-ref #{p\ 4116}# 0))) - (if (eqv? #{atom-key\ 4142}# 'each) - (if (null? #{e\ 4115}#) - (#{match-empty\ 4009}# - (vector-ref #{p\ 4116}# 1) - #{r\ 4118}#) + (let ((#{atom-key\ 4136}# + (vector-ref #{p\ 4110}# 0))) + (if (eqv? #{atom-key\ 4136}# 'each) + (if (null? #{e\ 4109}#) + (#{match-empty\ 4003}# + (vector-ref #{p\ 4110}# 1) + #{r\ 4112}#) (begin - (let ((#{l\ 4145}# - (#{match-each\ 4003}# - #{e\ 4115}# - (vector-ref #{p\ 4116}# 1) - #{w\ 4117}# - #{mod\ 4119}#))) - (if #{l\ 4145}# + (let ((#{l\ 4139}# + (#{match-each\ 3997}# + #{e\ 4109}# + (vector-ref #{p\ 4110}# 1) + #{w\ 4111}# + #{mod\ 4113}#))) + (if #{l\ 4139}# (letrec* - ((#{collect\ 4150}# - (lambda (#{l\ 4151}#) - (if (null? (car #{l\ 4151}#)) - #{r\ 4118}# - (cons (map car #{l\ 4151}#) - (#{collect\ 4150}# + ((#{collect\ 4144}# + (lambda (#{l\ 4145}#) + (if (null? (car #{l\ 4145}#)) + #{r\ 4112}# + (cons (map car #{l\ 4145}#) + (#{collect\ 4144}# (map cdr - #{l\ 4151}#))))))) + #{l\ 4145}#))))))) (begin - (#{collect\ 4150}# #{l\ 4145}#))) + (#{collect\ 4144}# #{l\ 4139}#))) #f)))) - (if (eqv? #{atom-key\ 4142}# 'each+) + (if (eqv? #{atom-key\ 4136}# 'each+) (call-with-values (lambda () - (#{match-each+\ 4005}# - #{e\ 4115}# - (vector-ref #{p\ 4116}# 1) - (vector-ref #{p\ 4116}# 2) - (vector-ref #{p\ 4116}# 3) - #{w\ 4117}# - #{r\ 4118}# - #{mod\ 4119}#)) - (lambda (#{xr*\ 4153}# - #{y-pat\ 4154}# - #{r\ 4155}#) - (if #{r\ 4155}# - (if (null? #{y-pat\ 4154}#) - (if (null? #{xr*\ 4153}#) - (#{match-empty\ 4009}# - (vector-ref #{p\ 4116}# 1) - #{r\ 4155}#) - (#{combine\ 4011}# - #{xr*\ 4153}# - #{r\ 4155}#)) + (#{match-each+\ 3999}# + #{e\ 4109}# + (vector-ref #{p\ 4110}# 1) + (vector-ref #{p\ 4110}# 2) + (vector-ref #{p\ 4110}# 3) + #{w\ 4111}# + #{r\ 4112}# + #{mod\ 4113}#)) + (lambda (#{xr*\ 4147}# + #{y-pat\ 4148}# + #{r\ 4149}#) + (if #{r\ 4149}# + (if (null? #{y-pat\ 4148}#) + (if (null? #{xr*\ 4147}#) + (#{match-empty\ 4003}# + (vector-ref #{p\ 4110}# 1) + #{r\ 4149}#) + (#{combine\ 4005}# + #{xr*\ 4147}# + #{r\ 4149}#)) #f) #f))) - (if (eqv? #{atom-key\ 4142}# 'free-id) - (if (#{id?\ 379}# #{e\ 4115}#) - (if (#{free-id=?\ 435}# - (#{wrap\ 445}# - #{e\ 4115}# - #{w\ 4117}# - #{mod\ 4119}#) - (vector-ref #{p\ 4116}# 1)) - #{r\ 4118}# + (if (eqv? #{atom-key\ 4136}# 'free-id) + (if (#{id?\ 380}# #{e\ 4109}#) + (if (#{free-id=?\ 436}# + (#{wrap\ 446}# + #{e\ 4109}# + #{w\ 4111}# + #{mod\ 4113}#) + (vector-ref #{p\ 4110}# 1)) + #{r\ 4112}# #f) #f) - (if (eqv? #{atom-key\ 4142}# 'atom) + (if (eqv? #{atom-key\ 4136}# 'atom) (if (equal? - (vector-ref #{p\ 4116}# 1) - (#{strip\ 487}# - #{e\ 4115}# - #{w\ 4117}#)) - #{r\ 4118}# + (vector-ref #{p\ 4110}# 1) + (#{strip\ 486}# + #{e\ 4109}# + #{w\ 4111}#)) + #{r\ 4112}# #f) - (if (eqv? #{atom-key\ 4142}# 'vector) - (if (vector? #{e\ 4115}#) - (#{match\ 4015}# - (vector->list #{e\ 4115}#) - (vector-ref #{p\ 4116}# 1) - #{w\ 4117}# - #{r\ 4118}# - #{mod\ 4119}#) + (if (eqv? #{atom-key\ 4136}# 'vector) + (if (vector? #{e\ 4109}#) + (#{match\ 4009}# + (vector->list #{e\ 4109}#) + (vector-ref #{p\ 4110}# 1) + #{w\ 4111}# + #{r\ 4112}# + #{mod\ 4113}#) #f))))))))))))) - (#{match\ 4015}# - (lambda (#{e\ 4172}# - #{p\ 4173}# - #{w\ 4174}# - #{r\ 4175}# - #{mod\ 4176}#) - (if (not #{r\ 4175}#) + (#{match\ 4009}# + (lambda (#{e\ 4166}# + #{p\ 4167}# + #{w\ 4168}# + #{r\ 4169}# + #{mod\ 4170}#) + (if (not #{r\ 4169}#) #f - (if (eq? #{p\ 4173}# '_) - #{r\ 4175}# - (if (eq? #{p\ 4173}# 'any) - (cons (#{wrap\ 445}# - #{e\ 4172}# - #{w\ 4174}# - #{mod\ 4176}#) - #{r\ 4175}#) - (if (#{syntax-object?\ 345}# #{e\ 4172}#) - (#{match*\ 4013}# - (#{syntax-object-expression\ 347}# #{e\ 4172}#) - #{p\ 4173}# - (#{join-wraps\ 427}# - #{w\ 4174}# - (#{syntax-object-wrap\ 349}# #{e\ 4172}#)) - #{r\ 4175}# - (#{syntax-object-module\ 351}# #{e\ 4172}#)) - (#{match*\ 4013}# - #{e\ 4172}# - #{p\ 4173}# - #{w\ 4174}# - #{r\ 4175}# - #{mod\ 4176}#)))))))) + (if (eq? #{p\ 4167}# '_) + #{r\ 4169}# + (if (eq? #{p\ 4167}# 'any) + (cons (#{wrap\ 446}# + #{e\ 4166}# + #{w\ 4168}# + #{mod\ 4170}#) + #{r\ 4169}#) + (if (#{syntax-object?\ 346}# #{e\ 4166}#) + (#{match*\ 4007}# + (#{syntax-object-expression\ 348}# #{e\ 4166}#) + #{p\ 4167}# + (#{join-wraps\ 428}# + #{w\ 4168}# + (#{syntax-object-wrap\ 350}# #{e\ 4166}#)) + #{r\ 4169}# + (#{syntax-object-module\ 352}# #{e\ 4166}#)) + (#{match*\ 4007}# + #{e\ 4166}# + #{p\ 4167}# + #{w\ 4168}# + #{r\ 4169}# + #{mod\ 4170}#)))))))) (begin (set! $sc-dispatch - (lambda (#{e\ 4191}# #{p\ 4192}#) - (if (eq? #{p\ 4192}# 'any) - (list #{e\ 4191}#) - (if (eq? #{p\ 4192}# '_) + (lambda (#{e\ 4185}# #{p\ 4186}#) + (if (eq? #{p\ 4186}# 'any) + (list #{e\ 4185}#) + (if (eq? #{p\ 4186}# '_) '() - (if (#{syntax-object?\ 345}# #{e\ 4191}#) - (#{match*\ 4013}# - (#{syntax-object-expression\ 347}# #{e\ 4191}#) - #{p\ 4192}# - (#{syntax-object-wrap\ 349}# #{e\ 4191}#) + (if (#{syntax-object?\ 346}# #{e\ 4185}#) + (#{match*\ 4007}# + (#{syntax-object-expression\ 348}# #{e\ 4185}#) + #{p\ 4186}# + (#{syntax-object-wrap\ 350}# #{e\ 4185}#) '() - (#{syntax-object-module\ 351}# #{e\ 4191}#)) - (#{match*\ 4013}# - #{e\ 4191}# - #{p\ 4192}# + (#{syntax-object-module\ 352}# #{e\ 4185}#)) + (#{match*\ 4007}# + #{e\ 4185}# + #{p\ 4186}# '(()) '() #f)))))))))))))) @@ -14491,81 +14505,81 @@ (make-syntax-transformer 'with-syntax 'macro - (lambda (#{x\ 4203}#) - (let ((#{tmp\ 4205}# #{x\ 4203}#)) - (let ((#{tmp\ 4206}# + (lambda (#{x\ 4197}#) + (let ((#{tmp\ 4199}# #{x\ 4197}#)) + (let ((#{tmp\ 4200}# ($sc-dispatch - #{tmp\ 4205}# + #{tmp\ 4199}# '(_ () any . each-any)))) - (if #{tmp\ 4206}# + (if #{tmp\ 4200}# (@apply - (lambda (#{e1\ 4209}# #{e2\ 4210}#) + (lambda (#{e1\ 4203}# #{e2\ 4204}#) (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4207" "i4208")) + #("i4201" "i4202")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4204"))) + #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) - (cons #{e1\ 4209}# #{e2\ 4210}#))) - #{tmp\ 4206}#) - (let ((#{tmp\ 4212}# + (cons #{e1\ 4203}# #{e2\ 4204}#))) + #{tmp\ 4200}#) + (let ((#{tmp\ 4206}# ($sc-dispatch - #{tmp\ 4205}# + #{tmp\ 4199}# '(_ ((any any)) any . each-any)))) - (if #{tmp\ 4212}# + (if #{tmp\ 4206}# (@apply - (lambda (#{out\ 4217}# - #{in\ 4218}# - #{e1\ 4219}# - #{e2\ 4220}#) + (lambda (#{out\ 4211}# + #{in\ 4212}# + #{e1\ 4213}# + #{e2\ 4214}#) (list '#(syntax-object syntax-case ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4213" "i4214" "i4215" "i4216")) + #("i4207" "i4208" "i4209" "i4210")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4204"))) + #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) - #{in\ 4218}# + #{in\ 4212}# '() - (list #{out\ 4217}# + (list #{out\ 4211}# (cons '#(syntax-object begin ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4213" "i4214" "i4215" "i4216")) + #("i4207" "i4208" "i4209" "i4210")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4204"))) + #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) - (cons #{e1\ 4219}# #{e2\ 4220}#))))) - #{tmp\ 4212}#) - (let ((#{tmp\ 4222}# + (cons #{e1\ 4213}# #{e2\ 4214}#))))) + #{tmp\ 4206}#) + (let ((#{tmp\ 4216}# ($sc-dispatch - #{tmp\ 4205}# + #{tmp\ 4199}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 4222}# + (if #{tmp\ 4216}# (@apply - (lambda (#{out\ 4227}# - #{in\ 4228}# - #{e1\ 4229}# - #{e2\ 4230}#) + (lambda (#{out\ 4221}# + #{in\ 4222}# + #{e1\ 4223}# + #{e2\ 4224}#) (list '#(syntax-object syntax-case ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4223" "i4224" "i4225" "i4226")) + #("i4217" "i4218" "i4219" "i4220")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4204"))) + #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) (cons '#(syntax-object list @@ -14573,61 +14587,61 @@ #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4223" "i4224" "i4225" "i4226")) + #("i4217" "i4218" "i4219" "i4220")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4204"))) + #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) - #{in\ 4228}#) + #{in\ 4222}#) '() - (list #{out\ 4227}# + (list #{out\ 4221}# (cons '#(syntax-object begin ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4223" - "i4224" - "i4225" - "i4226")) + #("i4217" + "i4218" + "i4219" + "i4220")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4204"))) + #("i4198"))) (hygiene guile)) - (cons #{e1\ 4229}# #{e2\ 4230}#))))) - #{tmp\ 4222}#) + (cons #{e1\ 4223}# #{e2\ 4224}#))))) + #{tmp\ 4216}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4205}#))))))))))) + #{tmp\ 4199}#))))))))))) (define syntax-rules (make-syntax-transformer 'syntax-rules 'macro - (lambda (#{x\ 4234}#) - (let ((#{tmp\ 4236}# #{x\ 4234}#)) - (let ((#{tmp\ 4237}# + (lambda (#{x\ 4228}#) + (let ((#{tmp\ 4230}# #{x\ 4228}#)) + (let ((#{tmp\ 4231}# ($sc-dispatch - #{tmp\ 4236}# + #{tmp\ 4230}# '(_ each-any . #(each ((any . any) any)))))) - (if #{tmp\ 4237}# + (if #{tmp\ 4231}# (@apply - (lambda (#{k\ 4242}# - #{keyword\ 4243}# - #{pattern\ 4244}# - #{template\ 4245}#) + (lambda (#{k\ 4236}# + #{keyword\ 4237}# + #{pattern\ 4238}# + #{template\ 4239}#) (list '#(syntax-object lambda ((top) #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) '(#(syntax-object x @@ -14635,9 +14649,9 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile))) (vector '(#(syntax-object @@ -14646,9 +14660,9 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) . #(syntax-object @@ -14657,9 +14671,9 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile))) (cons '#(syntax-object patterns @@ -14667,20 +14681,20 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) - #{pattern\ 4244}#)) + #{pattern\ 4238}#)) (cons '#(syntax-object syntax-case ((top) #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) (cons '#(syntax-object x @@ -14688,13 +14702,13 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4238" "i4239" "i4240" "i4241")) + #("i4232" "i4233" "i4234" "i4235")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) - (cons #{k\ 4242}# - (map (lambda (#{tmp\ 4249}# - #{tmp\ 4248}#) + (cons #{k\ 4236}# + (map (lambda (#{tmp\ 4243}# + #{tmp\ 4242}#) (list (cons '#(syntax-object dummy ((top) @@ -14707,10 +14721,10 @@ (top) (top) (top)) - #("i4238" - "i4239" - "i4240" - "i4241")) + #("i4232" + "i4233" + "i4234" + "i4235")) #(ribcage () () @@ -14718,9 +14732,9 @@ #(ribcage #(x) #((top)) - #("i4235"))) + #("i4229"))) (hygiene guile)) - #{tmp\ 4248}#) + #{tmp\ 4242}#) (list '#(syntax-object syntax ((top) @@ -14733,10 +14747,10 @@ (top) (top) (top)) - #("i4238" - "i4239" - "i4240" - "i4241")) + #("i4232" + "i4233" + "i4234" + "i4235")) #(ribcage () () @@ -14744,41 +14758,41 @@ #(ribcage #(x) #((top)) - #("i4235"))) + #("i4229"))) (hygiene guile)) - #{tmp\ 4249}#))) - #{template\ 4245}# - #{pattern\ 4244}#)))))) - #{tmp\ 4237}#) - (let ((#{tmp\ 4250}# + #{tmp\ 4243}#))) + #{template\ 4239}# + #{pattern\ 4238}#)))))) + #{tmp\ 4231}#) + (let ((#{tmp\ 4244}# ($sc-dispatch - #{tmp\ 4236}# + #{tmp\ 4230}# '(_ each-any any . #(each ((any . any) any)))))) - (if (if #{tmp\ 4250}# + (if (if #{tmp\ 4244}# (@apply - (lambda (#{k\ 4256}# - #{docstring\ 4257}# - #{keyword\ 4258}# - #{pattern\ 4259}# - #{template\ 4260}#) - (string? (syntax->datum #{docstring\ 4257}#))) - #{tmp\ 4250}#) + (lambda (#{k\ 4250}# + #{docstring\ 4251}# + #{keyword\ 4252}# + #{pattern\ 4253}# + #{template\ 4254}#) + (string? (syntax->datum #{docstring\ 4251}#))) + #{tmp\ 4244}#) #f) (@apply - (lambda (#{k\ 4266}# - #{docstring\ 4267}# - #{keyword\ 4268}# - #{pattern\ 4269}# - #{template\ 4270}#) + (lambda (#{k\ 4260}# + #{docstring\ 4261}# + #{keyword\ 4262}# + #{pattern\ 4263}# + #{template\ 4264}#) (list '#(syntax-object lambda ((top) #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4261" "i4262" "i4263" "i4264" "i4265")) + #("i4255" "i4256" "i4257" "i4258" "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) '(#(syntax-object x @@ -14786,11 +14800,11 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4261" "i4262" "i4263" "i4264" "i4265")) + #("i4255" "i4256" "i4257" "i4258" "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile))) - #{docstring\ 4267}# + #{docstring\ 4261}# (vector '(#(syntax-object macro-type @@ -14798,9 +14812,9 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4261" "i4262" "i4263" "i4264" "i4265")) + #("i4255" "i4256" "i4257" "i4258" "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) . #(syntax-object @@ -14809,9 +14823,9 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4261" "i4262" "i4263" "i4264" "i4265")) + #("i4255" "i4256" "i4257" "i4258" "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile))) (cons '#(syntax-object patterns @@ -14819,28 +14833,28 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4261" - "i4262" - "i4263" - "i4264" - "i4265")) + #("i4255" + "i4256" + "i4257" + "i4258" + "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) - #{pattern\ 4269}#)) + #{pattern\ 4263}#)) (cons '#(syntax-object syntax-case ((top) #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4261" - "i4262" - "i4263" - "i4264" - "i4265")) + #("i4255" + "i4256" + "i4257" + "i4258" + "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) (cons '#(syntax-object x @@ -14852,17 +14866,17 @@ pattern template) #((top) (top) (top) (top) (top)) - #("i4261" - "i4262" - "i4263" - "i4264" - "i4265")) + #("i4255" + "i4256" + "i4257" + "i4258" + "i4259")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4235"))) + #(ribcage #(x) #((top)) #("i4229"))) (hygiene guile)) - (cons #{k\ 4266}# - (map (lambda (#{tmp\ 4274}# - #{tmp\ 4273}#) + (cons #{k\ 4260}# + (map (lambda (#{tmp\ 4268}# + #{tmp\ 4267}#) (list (cons '#(syntax-object dummy ((top) @@ -14877,11 +14891,11 @@ (top) (top) (top)) - #("i4261" - "i4262" - "i4263" - "i4264" - "i4265")) + #("i4255" + "i4256" + "i4257" + "i4258" + "i4259")) #(ribcage () () @@ -14889,10 +14903,10 @@ #(ribcage #(x) #((top)) - #("i4235"))) + #("i4229"))) (hygiene guile)) - #{tmp\ 4273}#) + #{tmp\ 4267}#) (list '#(syntax-object syntax ((top) @@ -14907,11 +14921,11 @@ (top) (top) (top)) - #("i4261" - "i4262" - "i4263" - "i4264" - "i4265")) + #("i4255" + "i4256" + "i4257" + "i4258" + "i4259")) #(ribcage () () @@ -14919,48 +14933,48 @@ #(ribcage #(x) #((top)) - #("i4235"))) + #("i4229"))) (hygiene guile)) - #{tmp\ 4274}#))) - #{template\ 4270}# - #{pattern\ 4269}#)))))) - #{tmp\ 4250}#) + #{tmp\ 4268}#))) + #{template\ 4264}# + #{pattern\ 4263}#)))))) + #{tmp\ 4244}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4236}#))))))))) + #{tmp\ 4230}#))))))))) (define let* (make-syntax-transformer 'let* 'macro - (lambda (#{x\ 4275}#) - (let ((#{tmp\ 4277}# #{x\ 4275}#)) - (let ((#{tmp\ 4278}# + (lambda (#{x\ 4269}#) + (let ((#{tmp\ 4271}# #{x\ 4269}#)) + (let ((#{tmp\ 4272}# ($sc-dispatch - #{tmp\ 4277}# + #{tmp\ 4271}# '(any #(each (any any)) any . each-any)))) - (if (if #{tmp\ 4278}# + (if (if #{tmp\ 4272}# (@apply - (lambda (#{let*\ 4284}# - #{x\ 4285}# - #{v\ 4286}# - #{e1\ 4287}# - #{e2\ 4288}#) - (and-map identifier? #{x\ 4285}#)) - #{tmp\ 4278}#) + (lambda (#{let*\ 4278}# + #{x\ 4279}# + #{v\ 4280}# + #{e1\ 4281}# + #{e2\ 4282}#) + (and-map identifier? #{x\ 4279}#)) + #{tmp\ 4272}#) #f) (@apply - (lambda (#{let*\ 4295}# - #{x\ 4296}# - #{v\ 4297}# - #{e1\ 4298}# - #{e2\ 4299}#) + (lambda (#{let*\ 4289}# + #{x\ 4290}# + #{v\ 4291}# + #{e1\ 4292}# + #{e2\ 4293}#) (letrec* - ((#{f\ 4302}# - (lambda (#{bindings\ 4303}#) - (if (null? #{bindings\ 4303}#) + ((#{f\ 4296}# + (lambda (#{bindings\ 4297}#) + (if (null? #{bindings\ 4297}#) (cons '#(syntax-object let ((top) @@ -14968,123 +14982,123 @@ #(ribcage #(f bindings) #((top) (top)) - #("i4300" "i4301")) + #("i4294" "i4295")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) - #("i4290" - "i4291" - "i4292" - "i4293" - "i4294")) + #("i4284" + "i4285" + "i4286" + "i4287" + "i4288")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4276"))) + #(ribcage #(x) #((top)) #("i4270"))) (hygiene guile)) - (cons '() (cons #{e1\ 4298}# #{e2\ 4299}#))) - (let ((#{tmp\ 4308}# - (list (#{f\ 4302}# (cdr #{bindings\ 4303}#)) - (car #{bindings\ 4303}#)))) - (let ((#{tmp\ 4309}# - ($sc-dispatch #{tmp\ 4308}# '(any any)))) - (if #{tmp\ 4309}# + (cons '() (cons #{e1\ 4292}# #{e2\ 4293}#))) + (let ((#{tmp\ 4302}# + (list (#{f\ 4296}# (cdr #{bindings\ 4297}#)) + (car #{bindings\ 4297}#)))) + (let ((#{tmp\ 4303}# + ($sc-dispatch #{tmp\ 4302}# '(any any)))) + (if #{tmp\ 4303}# (@apply - (lambda (#{body\ 4312}# #{binding\ 4313}#) + (lambda (#{body\ 4306}# #{binding\ 4307}#) (list '#(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) - #("i4310" "i4311")) + #("i4304" "i4305")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) - #("i4300" "i4301")) + #("i4294" "i4295")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) - #("i4290" - "i4291" - "i4292" - "i4293" - "i4294")) + #("i4284" + "i4285" + "i4286" + "i4287" + "i4288")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4276"))) + #("i4270"))) (hygiene guile)) - (list #{binding\ 4313}#) - #{body\ 4312}#)) - #{tmp\ 4309}#) + (list #{binding\ 4307}#) + #{body\ 4306}#)) + #{tmp\ 4303}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4308}#)))))))) + #{tmp\ 4302}#)))))))) (begin - (#{f\ 4302}# (map list #{x\ 4296}# #{v\ 4297}#))))) - #{tmp\ 4278}#) + (#{f\ 4296}# (map list #{x\ 4290}# #{v\ 4291}#))))) + #{tmp\ 4272}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4277}#))))))) + #{tmp\ 4271}#))))))) (define do (make-syntax-transformer 'do 'macro - (lambda (#{orig-x\ 4314}#) - (let ((#{tmp\ 4316}# #{orig-x\ 4314}#)) - (let ((#{tmp\ 4317}# + (lambda (#{orig-x\ 4308}#) + (let ((#{tmp\ 4310}# #{orig-x\ 4308}#)) + (let ((#{tmp\ 4311}# ($sc-dispatch - #{tmp\ 4316}# + #{tmp\ 4310}# '(_ #(each (any any . any)) (any . each-any) . each-any)))) - (if #{tmp\ 4317}# + (if #{tmp\ 4311}# (@apply - (lambda (#{var\ 4324}# - #{init\ 4325}# - #{step\ 4326}# - #{e0\ 4327}# - #{e1\ 4328}# - #{c\ 4329}#) - (let ((#{tmp\ 4331}# - (map (lambda (#{v\ 4352}# #{s\ 4353}#) - (let ((#{tmp\ 4356}# #{s\ 4353}#)) - (let ((#{tmp\ 4357}# - ($sc-dispatch #{tmp\ 4356}# '()))) - (if #{tmp\ 4357}# + (lambda (#{var\ 4318}# + #{init\ 4319}# + #{step\ 4320}# + #{e0\ 4321}# + #{e1\ 4322}# + #{c\ 4323}#) + (let ((#{tmp\ 4325}# + (map (lambda (#{v\ 4346}# #{s\ 4347}#) + (let ((#{tmp\ 4350}# #{s\ 4347}#)) + (let ((#{tmp\ 4351}# + ($sc-dispatch #{tmp\ 4350}# '()))) + (if #{tmp\ 4351}# (@apply - (lambda () #{v\ 4352}#) - #{tmp\ 4357}#) - (let ((#{tmp\ 4358}# + (lambda () #{v\ 4346}#) + #{tmp\ 4351}#) + (let ((#{tmp\ 4352}# ($sc-dispatch - #{tmp\ 4356}# + #{tmp\ 4350}# '(any)))) - (if #{tmp\ 4358}# + (if #{tmp\ 4352}# (@apply - (lambda (#{e\ 4360}#) #{e\ 4360}#) - #{tmp\ 4358}#) - (let ((#{_\ 4362}# #{tmp\ 4356}#)) + (lambda (#{e\ 4354}#) #{e\ 4354}#) + #{tmp\ 4352}#) + (let ((#{_\ 4356}# #{tmp\ 4350}#)) (syntax-violation 'do "bad step expression" - #{orig-x\ 4314}# - #{s\ 4353}#)))))))) - #{var\ 4324}# - #{step\ 4326}#))) - (let ((#{tmp\ 4332}# - ($sc-dispatch #{tmp\ 4331}# 'each-any))) - (if #{tmp\ 4332}# + #{orig-x\ 4308}# + #{s\ 4347}#)))))))) + #{var\ 4318}# + #{step\ 4320}#))) + (let ((#{tmp\ 4326}# + ($sc-dispatch #{tmp\ 4325}# 'each-any))) + (if #{tmp\ 4326}# (@apply - (lambda (#{step\ 4334}#) - (let ((#{tmp\ 4335}# #{e1\ 4328}#)) - (let ((#{tmp\ 4336}# - ($sc-dispatch #{tmp\ 4335}# '()))) - (if #{tmp\ 4336}# + (lambda (#{step\ 4328}#) + (let ((#{tmp\ 4329}# #{e1\ 4322}#)) + (let ((#{tmp\ 4330}# + ($sc-dispatch #{tmp\ 4329}# '()))) + (if #{tmp\ 4330}# (@apply (lambda () (list '#(syntax-object @@ -15093,7 +15107,7 @@ #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15102,17 +15116,17 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) '#(syntax-object doloop @@ -15120,7 +15134,7 @@ #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15129,28 +15143,28 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) (map list - #{var\ 4324}# - #{init\ 4325}#) + #{var\ 4318}# + #{init\ 4319}#) (list '#(syntax-object if ((top) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15159,17 +15173,17 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) (list '#(syntax-object not @@ -15177,7 +15191,7 @@ #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15191,26 +15205,26 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) - #{e0\ 4327}#) + #{e0\ 4321}#) (cons '#(syntax-object begin ((top) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15224,27 +15238,27 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) (append - #{c\ 4329}# + #{c\ 4323}# (list (cons '#(syntax-object doloop ((top) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15258,12 +15272,12 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () @@ -15271,29 +15285,29 @@ #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) - #{step\ 4334}#))))))) - #{tmp\ 4336}#) - (let ((#{tmp\ 4341}# + #{step\ 4328}#))))))) + #{tmp\ 4330}#) + (let ((#{tmp\ 4335}# ($sc-dispatch - #{tmp\ 4335}# + #{tmp\ 4329}# '(any . each-any)))) - (if #{tmp\ 4341}# + (if #{tmp\ 4335}# (@apply - (lambda (#{e1\ 4344}# #{e2\ 4345}#) + (lambda (#{e1\ 4338}# #{e2\ 4339}#) (list '#(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4342" "i4343")) + #("i4336" "i4337")) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15302,17 +15316,17 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) '#(syntax-object doloop @@ -15320,11 +15334,11 @@ #(ribcage #(e1 e2) #((top) (top)) - #("i4342" "i4343")) + #("i4336" "i4337")) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15333,32 +15347,32 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) (map list - #{var\ 4324}# - #{init\ 4325}#) + #{var\ 4318}# + #{init\ 4319}#) (list '#(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4342" "i4343")) + #("i4336" "i4337")) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15372,31 +15386,31 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) - #{e0\ 4327}# + #{e0\ 4321}# (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4342" - "i4343")) + #("i4336" + "i4337")) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15410,12 +15424,12 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () @@ -15423,22 +15437,22 @@ #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) - (cons #{e1\ 4344}# - #{e2\ 4345}#)) + (cons #{e1\ 4338}# + #{e2\ 4339}#)) (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4342" - "i4343")) + #("i4336" + "i4337")) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15452,12 +15466,12 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () @@ -15465,10 +15479,10 @@ #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) (append - #{c\ 4329}# + #{c\ 4323}# (list (cons '#(syntax-object doloop ((top) @@ -15477,12 +15491,12 @@ e2) #((top) (top)) - #("i4342" - "i4343")) + #("i4336" + "i4337")) #(ribcage #(step) #((top)) - #("i4333")) + #("i4327")) #(ribcage #(var init @@ -15496,12 +15510,12 @@ (top) (top) (top)) - #("i4318" - "i4319" - "i4320" - "i4321" - "i4322" - "i4323")) + #("i4312" + "i4313" + "i4314" + "i4315" + "i4316" + "i4317")) #(ribcage () () @@ -15509,37 +15523,37 @@ #(ribcage #(orig-x) #((top)) - #("i4315"))) + #("i4309"))) (hygiene guile)) - #{step\ 4334}#))))))) - #{tmp\ 4341}#) + #{step\ 4328}#))))))) + #{tmp\ 4335}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4335}#))))))) - #{tmp\ 4332}#) + #{tmp\ 4329}#))))))) + #{tmp\ 4326}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4331}#))))) - #{tmp\ 4317}#) + #{tmp\ 4325}#))))) + #{tmp\ 4311}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4316}#))))))) + #{tmp\ 4310}#))))))) (define quasiquote (make-syntax-transformer 'quasiquote 'macro (letrec* - ((#{quasi\ 4366}# - (lambda (#{p\ 4379}# #{lev\ 4380}#) - (let ((#{tmp\ 4383}# #{p\ 4379}#)) - (let ((#{tmp\ 4384}# + ((#{quasi\ 4360}# + (lambda (#{p\ 4373}# #{lev\ 4374}#) + (let ((#{tmp\ 4377}# #{p\ 4373}#)) + (let ((#{tmp\ 4378}# ($sc-dispatch - #{tmp\ 4383}# + #{tmp\ 4377}# '(#(free-id #(syntax-object unquote @@ -15548,7 +15562,7 @@ #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15557,28 +15571,28 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) any)))) - (if #{tmp\ 4384}# + (if #{tmp\ 4378}# (@apply - (lambda (#{p\ 4386}#) - (if (= #{lev\ 4380}# 0) + (lambda (#{p\ 4380}#) + (if (= #{lev\ 4374}# 0) (list '#(syntax-object "value" ((top) - #(ribcage #(p) #((top)) #("i4385")) + #(ribcage #(p) #((top)) #("i4379")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15587,25 +15601,25 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{p\ 4386}#) - (#{quasicons\ 4370}# + #{p\ 4380}#) + (#{quasicons\ 4364}# '(#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4385")) + #(ribcage #(p) #((top)) #("i4379")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15614,23 +15628,23 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) #(syntax-object unquote ((top) - #(ribcage #(p) #((top)) #("i4385")) + #(ribcage #(p) #((top)) #("i4379")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15639,21 +15653,21 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) - (#{quasi\ 4366}# - (list #{p\ 4386}#) - (1- #{lev\ 4380}#))))) - #{tmp\ 4384}#) - (let ((#{tmp\ 4387}# + (#{quasi\ 4360}# + (list #{p\ 4380}#) + (1- #{lev\ 4374}#))))) + #{tmp\ 4378}#) + (let ((#{tmp\ 4381}# ($sc-dispatch - #{tmp\ 4383}# + #{tmp\ 4377}# '(#(free-id #(syntax-object quasiquote @@ -15662,7 +15676,7 @@ #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15671,28 +15685,28 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) any)))) - (if #{tmp\ 4387}# + (if #{tmp\ 4381}# (@apply - (lambda (#{p\ 4389}#) - (#{quasicons\ 4370}# + (lambda (#{p\ 4383}#) + (#{quasicons\ 4364}# '(#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4388")) + #(ribcage #(p) #((top)) #("i4382")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15701,23 +15715,23 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) #(syntax-object quasiquote ((top) - #(ribcage #(p) #((top)) #("i4388")) + #(ribcage #(p) #((top)) #("i4382")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15726,27 +15740,27 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) - (#{quasi\ 4366}# - (list #{p\ 4389}#) - (1+ #{lev\ 4380}#)))) - #{tmp\ 4387}#) - (let ((#{tmp\ 4390}# - ($sc-dispatch #{tmp\ 4383}# '(any . any)))) - (if #{tmp\ 4390}# + (#{quasi\ 4360}# + (list #{p\ 4383}#) + (1+ #{lev\ 4374}#)))) + #{tmp\ 4381}#) + (let ((#{tmp\ 4384}# + ($sc-dispatch #{tmp\ 4377}# '(any . any)))) + (if #{tmp\ 4384}# (@apply - (lambda (#{p\ 4393}# #{q\ 4394}#) - (let ((#{tmp\ 4395}# #{p\ 4393}#)) - (let ((#{tmp\ 4396}# + (lambda (#{p\ 4387}# #{q\ 4388}#) + (let ((#{tmp\ 4389}# #{p\ 4387}#)) + (let ((#{tmp\ 4390}# ($sc-dispatch - #{tmp\ 4395}# + #{tmp\ 4389}# '(#(free-id #(syntax-object unquote @@ -15754,12 +15768,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4391" "i4392")) + #("i4385" "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15774,40 +15788,40 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4396}# + (if #{tmp\ 4390}# (@apply - (lambda (#{p\ 4398}#) - (if (= #{lev\ 4380}# 0) - (#{quasilist*\ 4374}# - (map (lambda (#{tmp\ 4399}#) + (lambda (#{p\ 4392}#) + (if (= #{lev\ 4374}# 0) + (#{quasilist*\ 4368}# + (map (lambda (#{tmp\ 4393}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4397")) + #("i4391")) #(ribcage #(p q) #((top) (top)) - #("i4391" - "i4392")) + #("i4385" + "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" - "i4382")) + #("i4375" + "i4376")) #(ribcage (emit quasivector quasilist* @@ -15822,37 +15836,37 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{tmp\ 4399}#)) - #{p\ 4398}#) - (#{quasi\ 4366}# - #{q\ 4394}# - #{lev\ 4380}#)) - (#{quasicons\ 4370}# - (#{quasicons\ 4370}# + #{tmp\ 4393}#)) + #{p\ 4392}#) + (#{quasi\ 4360}# + #{q\ 4388}# + #{lev\ 4374}#)) + (#{quasicons\ 4364}# + (#{quasicons\ 4364}# '(#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) - #("i4397")) + #("i4391")) #(ribcage #(p q) #((top) (top)) - #("i4391" "i4392")) + #("i4385" "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15867,13 +15881,13 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) #(syntax-object unquote @@ -15881,16 +15895,16 @@ #(ribcage #(p) #((top)) - #("i4397")) + #("i4391")) #(ribcage #(p q) #((top) (top)) - #("i4391" "i4392")) + #("i4385" "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15905,24 +15919,24 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) - (#{quasi\ 4366}# - #{p\ 4398}# - (1- #{lev\ 4380}#))) - (#{quasi\ 4366}# - #{q\ 4394}# - #{lev\ 4380}#)))) - #{tmp\ 4396}#) - (let ((#{tmp\ 4401}# + (#{quasi\ 4360}# + #{p\ 4392}# + (1- #{lev\ 4374}#))) + (#{quasi\ 4360}# + #{q\ 4388}# + #{lev\ 4374}#)))) + #{tmp\ 4390}#) + (let ((#{tmp\ 4395}# ($sc-dispatch - #{tmp\ 4395}# + #{tmp\ 4389}# '(#(free-id #(syntax-object unquote-splicing @@ -15930,12 +15944,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4391" "i4392")) + #("i4385" "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -15950,35 +15964,35 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4401}# + (if #{tmp\ 4395}# (@apply - (lambda (#{p\ 4403}#) - (if (= #{lev\ 4380}# 0) - (#{quasiappend\ 4372}# - (map (lambda (#{tmp\ 4404}#) + (lambda (#{p\ 4397}#) + (if (= #{lev\ 4374}# 0) + (#{quasiappend\ 4366}# + (map (lambda (#{tmp\ 4398}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4402")) + #("i4396")) #(ribcage #(p q) #((top) (top)) - #("i4391" - "i4392")) + #("i4385" + "i4386")) #(ribcage () () @@ -15987,8 +16001,8 @@ #(p lev) #((top) (top)) - #("i4381" - "i4382")) + #("i4375" + "i4376")) #(ribcage (emit quasivector quasilist* @@ -16003,37 +16017,37 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{tmp\ 4404}#)) - #{p\ 4403}#) - (#{quasi\ 4366}# - #{q\ 4394}# - #{lev\ 4380}#)) - (#{quasicons\ 4370}# - (#{quasicons\ 4370}# + #{tmp\ 4398}#)) + #{p\ 4397}#) + (#{quasi\ 4360}# + #{q\ 4388}# + #{lev\ 4374}#)) + (#{quasicons\ 4364}# + (#{quasicons\ 4364}# '(#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) - #("i4402")) + #("i4396")) #(ribcage #(p q) #((top) (top)) - #("i4391" "i4392")) + #("i4385" "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -16048,13 +16062,13 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) #(syntax-object unquote-splicing @@ -16062,16 +16076,16 @@ #(ribcage #(p) #((top)) - #("i4402")) + #("i4396")) #(ribcage #(p q) #((top) (top)) - #("i4391" "i4392")) + #("i4385" "i4386")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -16086,52 +16100,52 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) - (#{quasi\ 4366}# - #{p\ 4403}# - (1- #{lev\ 4380}#))) - (#{quasi\ 4366}# - #{q\ 4394}# - #{lev\ 4380}#)))) - #{tmp\ 4401}#) - (let ((#{_\ 4407}# #{tmp\ 4395}#)) - (#{quasicons\ 4370}# - (#{quasi\ 4366}# - #{p\ 4393}# - #{lev\ 4380}#) - (#{quasi\ 4366}# - #{q\ 4394}# - #{lev\ 4380}#))))))))) - #{tmp\ 4390}#) - (let ((#{tmp\ 4408}# + (#{quasi\ 4360}# + #{p\ 4397}# + (1- #{lev\ 4374}#))) + (#{quasi\ 4360}# + #{q\ 4388}# + #{lev\ 4374}#)))) + #{tmp\ 4395}#) + (let ((#{_\ 4401}# #{tmp\ 4389}#)) + (#{quasicons\ 4364}# + (#{quasi\ 4360}# + #{p\ 4387}# + #{lev\ 4374}#) + (#{quasi\ 4360}# + #{q\ 4388}# + #{lev\ 4374}#))))))))) + #{tmp\ 4384}#) + (let ((#{tmp\ 4402}# ($sc-dispatch - #{tmp\ 4383}# + #{tmp\ 4377}# '#(vector each-any)))) - (if #{tmp\ 4408}# + (if #{tmp\ 4402}# (@apply - (lambda (#{x\ 4410}#) - (#{quasivector\ 4376}# - (#{vquasi\ 4368}# - #{x\ 4410}# - #{lev\ 4380}#))) - #{tmp\ 4408}#) - (let ((#{p\ 4413}# #{tmp\ 4383}#)) + (lambda (#{x\ 4404}#) + (#{quasivector\ 4370}# + (#{vquasi\ 4362}# + #{x\ 4404}# + #{lev\ 4374}#))) + #{tmp\ 4402}#) + (let ((#{p\ 4407}# #{tmp\ 4377}#)) (list '#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4412")) + #(ribcage #(p) #((top)) #("i4406")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4381" "i4382")) + #("i4375" "i4376")) #(ribcage (emit quasivector quasilist* @@ -16146,27 +16160,27 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{p\ 4413}#))))))))))))) - (#{vquasi\ 4368}# - (lambda (#{p\ 4414}# #{lev\ 4415}#) - (let ((#{tmp\ 4418}# #{p\ 4414}#)) - (let ((#{tmp\ 4419}# - ($sc-dispatch #{tmp\ 4418}# '(any . any)))) - (if #{tmp\ 4419}# + #{p\ 4407}#))))))))))))) + (#{vquasi\ 4362}# + (lambda (#{p\ 4408}# #{lev\ 4409}#) + (let ((#{tmp\ 4412}# #{p\ 4408}#)) + (let ((#{tmp\ 4413}# + ($sc-dispatch #{tmp\ 4412}# '(any . any)))) + (if #{tmp\ 4413}# (@apply - (lambda (#{p\ 4422}# #{q\ 4423}#) - (let ((#{tmp\ 4424}# #{p\ 4422}#)) - (let ((#{tmp\ 4425}# + (lambda (#{p\ 4416}# #{q\ 4417}#) + (let ((#{tmp\ 4418}# #{p\ 4416}#)) + (let ((#{tmp\ 4419}# ($sc-dispatch - #{tmp\ 4424}# + #{tmp\ 4418}# '(#(free-id #(syntax-object unquote @@ -16174,12 +16188,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16194,38 +16208,38 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4425}# + (if #{tmp\ 4419}# (@apply - (lambda (#{p\ 4427}#) - (if (= #{lev\ 4415}# 0) - (#{quasilist*\ 4374}# - (map (lambda (#{tmp\ 4428}#) + (lambda (#{p\ 4421}#) + (if (= #{lev\ 4409}# 0) + (#{quasilist*\ 4368}# + (map (lambda (#{tmp\ 4422}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4426")) + #("i4420")) #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16240,34 +16254,34 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{tmp\ 4428}#)) - #{p\ 4427}#) - (#{vquasi\ 4368}# - #{q\ 4423}# - #{lev\ 4415}#)) - (#{quasicons\ 4370}# - (#{quasicons\ 4370}# + #{tmp\ 4422}#)) + #{p\ 4421}#) + (#{vquasi\ 4362}# + #{q\ 4417}# + #{lev\ 4409}#)) + (#{quasicons\ 4364}# + (#{quasicons\ 4364}# '(#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4426")) + #(ribcage #(p) #((top)) #("i4420")) #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16282,27 +16296,27 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) #(syntax-object unquote ((top) - #(ribcage #(p) #((top)) #("i4426")) + #(ribcage #(p) #((top)) #("i4420")) #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16317,24 +16331,24 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) - (#{quasi\ 4366}# - #{p\ 4427}# - (1- #{lev\ 4415}#))) - (#{vquasi\ 4368}# - #{q\ 4423}# - #{lev\ 4415}#)))) - #{tmp\ 4425}#) - (let ((#{tmp\ 4430}# + (#{quasi\ 4360}# + #{p\ 4421}# + (1- #{lev\ 4409}#))) + (#{vquasi\ 4362}# + #{q\ 4417}# + #{lev\ 4409}#)))) + #{tmp\ 4419}#) + (let ((#{tmp\ 4424}# ($sc-dispatch - #{tmp\ 4424}# + #{tmp\ 4418}# '(#(free-id #(syntax-object unquote-splicing @@ -16342,12 +16356,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16362,38 +16376,38 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4430}# + (if #{tmp\ 4424}# (@apply - (lambda (#{p\ 4432}#) - (if (= #{lev\ 4415}# 0) - (#{quasiappend\ 4372}# - (map (lambda (#{tmp\ 4433}#) + (lambda (#{p\ 4426}#) + (if (= #{lev\ 4409}# 0) + (#{quasiappend\ 4366}# + (map (lambda (#{tmp\ 4427}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4431")) + #("i4425")) #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16408,37 +16422,37 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{tmp\ 4433}#)) - #{p\ 4432}#) - (#{vquasi\ 4368}# - #{q\ 4423}# - #{lev\ 4415}#)) - (#{quasicons\ 4370}# - (#{quasicons\ 4370}# + #{tmp\ 4427}#)) + #{p\ 4426}#) + (#{vquasi\ 4362}# + #{q\ 4417}# + #{lev\ 4409}#)) + (#{quasicons\ 4364}# + (#{quasicons\ 4364}# '(#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) - #("i4431")) + #("i4425")) #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16453,13 +16467,13 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) #(syntax-object unquote-splicing @@ -16467,16 +16481,16 @@ #(ribcage #(p) #((top)) - #("i4431")) + #("i4425")) #(ribcage #(p q) #((top) (top)) - #("i4420" "i4421")) + #("i4414" "i4415")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16491,30 +16505,30 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile))) - (#{quasi\ 4366}# - #{p\ 4432}# - (1- #{lev\ 4415}#))) - (#{vquasi\ 4368}# - #{q\ 4423}# - #{lev\ 4415}#)))) - #{tmp\ 4430}#) - (let ((#{_\ 4436}# #{tmp\ 4424}#)) - (#{quasicons\ 4370}# - (#{quasi\ 4366}# #{p\ 4422}# #{lev\ 4415}#) - (#{vquasi\ 4368}# - #{q\ 4423}# - #{lev\ 4415}#))))))))) - #{tmp\ 4419}#) - (let ((#{tmp\ 4437}# ($sc-dispatch #{tmp\ 4418}# '()))) - (if #{tmp\ 4437}# + (#{quasi\ 4360}# + #{p\ 4426}# + (1- #{lev\ 4409}#))) + (#{vquasi\ 4362}# + #{q\ 4417}# + #{lev\ 4409}#)))) + #{tmp\ 4424}#) + (let ((#{_\ 4430}# #{tmp\ 4418}#)) + (#{quasicons\ 4364}# + (#{quasi\ 4360}# #{p\ 4416}# #{lev\ 4409}#) + (#{vquasi\ 4362}# + #{q\ 4417}# + #{lev\ 4409}#))))))))) + #{tmp\ 4413}#) + (let ((#{tmp\ 4431}# ($sc-dispatch #{tmp\ 4412}# '()))) + (if #{tmp\ 4431}# (@apply (lambda () '(#(syntax-object @@ -16524,7 +16538,7 @@ #(ribcage #(p lev) #((top) (top)) - #("i4416" "i4417")) + #("i4410" "i4411")) #(ribcage (emit quasivector quasilist* @@ -16533,65 +16547,65 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) ())) - #{tmp\ 4437}#) + #{tmp\ 4431}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4418}#)))))))) - (#{quasicons\ 4370}# - (lambda (#{x\ 4438}# #{y\ 4439}#) - (let ((#{tmp\ 4443}# (list #{x\ 4438}# #{y\ 4439}#))) - (let ((#{tmp\ 4444}# - ($sc-dispatch #{tmp\ 4443}# '(any any)))) - (if #{tmp\ 4444}# + #{tmp\ 4412}#)))))))) + (#{quasicons\ 4364}# + (lambda (#{x\ 4432}# #{y\ 4433}#) + (let ((#{tmp\ 4437}# (list #{x\ 4432}# #{y\ 4433}#))) + (let ((#{tmp\ 4438}# + ($sc-dispatch #{tmp\ 4437}# '(any any)))) + (if #{tmp\ 4438}# (@apply - (lambda (#{x\ 4447}# #{y\ 4448}#) - (let ((#{tmp\ 4449}# #{y\ 4448}#)) - (let ((#{tmp\ 4450}# + (lambda (#{x\ 4441}# #{y\ 4442}#) + (let ((#{tmp\ 4443}# #{y\ 4442}#)) + (let ((#{tmp\ 4444}# ($sc-dispatch - #{tmp\ 4449}# + #{tmp\ 4443}# '(#(atom "quote") any)))) - (if #{tmp\ 4450}# + (if #{tmp\ 4444}# (@apply - (lambda (#{dy\ 4452}#) - (let ((#{tmp\ 4453}# #{x\ 4447}#)) - (let ((#{tmp\ 4454}# + (lambda (#{dy\ 4446}#) + (let ((#{tmp\ 4447}# #{x\ 4441}#)) + (let ((#{tmp\ 4448}# ($sc-dispatch - #{tmp\ 4453}# + #{tmp\ 4447}# '(#(atom "quote") any)))) - (if #{tmp\ 4454}# + (if #{tmp\ 4448}# (@apply - (lambda (#{dx\ 4456}#) + (lambda (#{dx\ 4450}#) (list '#(syntax-object "quote" ((top) #(ribcage #(dx) #((top)) - #("i4455")) + #("i4449")) #(ribcage #(dy) #((top)) - #("i4451")) + #("i4445")) #(ribcage #(x y) #((top) (top)) - #("i4445" "i4446")) + #("i4439" "i4440")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4440" "i4441")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16606,40 +16620,40 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - (cons #{dx\ 4456}# - #{dy\ 4452}#))) - #{tmp\ 4454}#) - (let ((#{_\ 4458}# #{tmp\ 4453}#)) - (if (null? #{dy\ 4452}#) + (cons #{dx\ 4450}# + #{dy\ 4446}#))) + #{tmp\ 4448}#) + (let ((#{_\ 4452}# #{tmp\ 4447}#)) + (if (null? #{dy\ 4446}#) (list '#(syntax-object "list" ((top) #(ribcage #(_) #((top)) - #("i4457")) + #("i4451")) #(ribcage #(dy) #((top)) - #("i4451")) + #("i4445")) #(ribcage #(x y) #((top) (top)) - #("i4445" "i4446")) + #("i4439" "i4440")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4440" "i4441")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16654,36 +16668,36 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{x\ 4447}#) + #{x\ 4441}#) (list '#(syntax-object "list*" ((top) #(ribcage #(_) #((top)) - #("i4457")) + #("i4451")) #(ribcage #(dy) #((top)) - #("i4451")) + #("i4445")) #(ribcage #(x y) #((top) (top)) - #("i4445" "i4446")) + #("i4439" "i4440")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4440" "i4441")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16698,41 +16712,41 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{x\ 4447}# - #{y\ 4448}#))))))) - #{tmp\ 4450}#) - (let ((#{tmp\ 4459}# + #{x\ 4441}# + #{y\ 4442}#))))))) + #{tmp\ 4444}#) + (let ((#{tmp\ 4453}# ($sc-dispatch - #{tmp\ 4449}# + #{tmp\ 4443}# '(#(atom "list") . any)))) - (if #{tmp\ 4459}# + (if #{tmp\ 4453}# (@apply - (lambda (#{stuff\ 4461}#) + (lambda (#{stuff\ 4455}#) (cons '#(syntax-object "list" ((top) #(ribcage #(stuff) #((top)) - #("i4460")) + #("i4454")) #(ribcage #(x y) #((top) (top)) - #("i4445" "i4446")) + #("i4439" "i4440")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4440" "i4441")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16747,40 +16761,40 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - (cons #{x\ 4447}# #{stuff\ 4461}#))) - #{tmp\ 4459}#) - (let ((#{tmp\ 4462}# + (cons #{x\ 4441}# #{stuff\ 4455}#))) + #{tmp\ 4453}#) + (let ((#{tmp\ 4456}# ($sc-dispatch - #{tmp\ 4449}# + #{tmp\ 4443}# '(#(atom "list*") . any)))) - (if #{tmp\ 4462}# + (if #{tmp\ 4456}# (@apply - (lambda (#{stuff\ 4464}#) + (lambda (#{stuff\ 4458}#) (cons '#(syntax-object "list*" ((top) #(ribcage #(stuff) #((top)) - #("i4463")) + #("i4457")) #(ribcage #(x y) #((top) (top)) - #("i4445" "i4446")) + #("i4439" "i4440")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4440" "i4441")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16795,35 +16809,35 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - (cons #{x\ 4447}# - #{stuff\ 4464}#))) - #{tmp\ 4462}#) - (let ((#{_\ 4466}# #{tmp\ 4449}#)) + (cons #{x\ 4441}# + #{stuff\ 4458}#))) + #{tmp\ 4456}#) + (let ((#{_\ 4460}# #{tmp\ 4443}#)) (list '#(syntax-object "list*" ((top) #(ribcage #(_) #((top)) - #("i4465")) + #("i4459")) #(ribcage #(x y) #((top) (top)) - #("i4445" "i4446")) + #("i4439" "i4440")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4440" "i4441")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16838,32 +16852,32 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{x\ 4447}# - #{y\ 4448}#)))))))))) - #{tmp\ 4444}#) + #{x\ 4441}# + #{y\ 4442}#)))))))))) + #{tmp\ 4438}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4443}#)))))) - (#{quasiappend\ 4372}# - (lambda (#{x\ 4467}# #{y\ 4468}#) - (let ((#{tmp\ 4471}# #{y\ 4468}#)) - (let ((#{tmp\ 4472}# + #{tmp\ 4437}#)))))) + (#{quasiappend\ 4366}# + (lambda (#{x\ 4461}# #{y\ 4462}#) + (let ((#{tmp\ 4465}# #{y\ 4462}#)) + (let ((#{tmp\ 4466}# ($sc-dispatch - #{tmp\ 4471}# + #{tmp\ 4465}# '(#(atom "quote") ())))) - (if #{tmp\ 4472}# + (if #{tmp\ 4466}# (@apply (lambda () - (if (null? #{x\ 4467}#) + (if (null? #{x\ 4461}#) '(#(syntax-object "quote" ((top) @@ -16871,7 +16885,7 @@ #(ribcage #(x y) #((top) (top)) - #("i4469" "i4470")) + #("i4463" "i4464")) #(ribcage (emit quasivector quasilist* @@ -16880,35 +16894,35 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) ()) - (if (null? (cdr #{x\ 4467}#)) - (car #{x\ 4467}#) - (let ((#{tmp\ 4479}# #{x\ 4467}#)) - (let ((#{tmp\ 4480}# - ($sc-dispatch #{tmp\ 4479}# 'each-any))) - (if #{tmp\ 4480}# + (if (null? (cdr #{x\ 4461}#)) + (car #{x\ 4461}#) + (let ((#{tmp\ 4473}# #{x\ 4461}#)) + (let ((#{tmp\ 4474}# + ($sc-dispatch #{tmp\ 4473}# 'each-any))) + (if #{tmp\ 4474}# (@apply - (lambda (#{p\ 4482}#) + (lambda (#{p\ 4476}#) (cons '#(syntax-object "append" ((top) #(ribcage #(p) #((top)) - #("i4481")) + #("i4475")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4469" "i4470")) + #("i4463" "i4464")) #(ribcage (emit quasivector quasilist* @@ -16923,43 +16937,43 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{p\ 4482}#)) - #{tmp\ 4480}#) + #{p\ 4476}#)) + #{tmp\ 4474}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4479}#))))))) - #{tmp\ 4472}#) - (let ((#{_\ 4485}# #{tmp\ 4471}#)) - (if (null? #{x\ 4467}#) - #{y\ 4468}# - (let ((#{tmp\ 4490}# (list #{x\ 4467}# #{y\ 4468}#))) - (let ((#{tmp\ 4491}# - ($sc-dispatch #{tmp\ 4490}# '(each-any any)))) - (if #{tmp\ 4491}# + #{tmp\ 4473}#))))))) + #{tmp\ 4466}#) + (let ((#{_\ 4479}# #{tmp\ 4465}#)) + (if (null? #{x\ 4461}#) + #{y\ 4462}# + (let ((#{tmp\ 4484}# (list #{x\ 4461}# #{y\ 4462}#))) + (let ((#{tmp\ 4485}# + ($sc-dispatch #{tmp\ 4484}# '(each-any any)))) + (if #{tmp\ 4485}# (@apply - (lambda (#{p\ 4494}# #{y\ 4495}#) + (lambda (#{p\ 4488}# #{y\ 4489}#) (cons '#(syntax-object "append" ((top) #(ribcage #(p y) #((top) (top)) - #("i4492" "i4493")) - #(ribcage #(_) #((top)) #("i4484")) + #("i4486" "i4487")) + #(ribcage #(_) #((top)) #("i4478")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4469" "i4470")) + #("i4463" "i4464")) #(ribcage (emit quasivector quasilist* @@ -16974,47 +16988,47 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - (append #{p\ 4494}# (list #{y\ 4495}#)))) - #{tmp\ 4491}#) + (append #{p\ 4488}# (list #{y\ 4489}#)))) + #{tmp\ 4485}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4490}#))))))))))) - (#{quasilist*\ 4374}# - (lambda (#{x\ 4497}# #{y\ 4498}#) + #{tmp\ 4484}#))))))))))) + (#{quasilist*\ 4368}# + (lambda (#{x\ 4491}# #{y\ 4492}#) (letrec* - ((#{f\ 4503}# - (lambda (#{x\ 4504}#) - (if (null? #{x\ 4504}#) - #{y\ 4498}# - (#{quasicons\ 4370}# - (car #{x\ 4504}#) - (#{f\ 4503}# (cdr #{x\ 4504}#))))))) - (begin (#{f\ 4503}# #{x\ 4497}#))))) - (#{quasivector\ 4376}# - (lambda (#{x\ 4505}#) - (let ((#{tmp\ 4507}# #{x\ 4505}#)) - (let ((#{tmp\ 4508}# + ((#{f\ 4497}# + (lambda (#{x\ 4498}#) + (if (null? #{x\ 4498}#) + #{y\ 4492}# + (#{quasicons\ 4364}# + (car #{x\ 4498}#) + (#{f\ 4497}# (cdr #{x\ 4498}#))))))) + (begin (#{f\ 4497}# #{x\ 4491}#))))) + (#{quasivector\ 4370}# + (lambda (#{x\ 4499}#) + (let ((#{tmp\ 4501}# #{x\ 4499}#)) + (let ((#{tmp\ 4502}# ($sc-dispatch - #{tmp\ 4507}# + #{tmp\ 4501}# '(#(atom "quote") each-any)))) - (if #{tmp\ 4508}# + (if #{tmp\ 4502}# (@apply - (lambda (#{x\ 4510}#) + (lambda (#{x\ 4504}#) (list '#(syntax-object "quote" ((top) - #(ribcage #(x) #((top)) #("i4509")) + #(ribcage #(x) #((top)) #("i4503")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4506")) + #(ribcage #(x) #((top)) #("i4500")) #(ribcage (emit quasivector quasilist* @@ -17023,53 +17037,53 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - (list->vector #{x\ 4510}#))) - #{tmp\ 4508}#) - (let ((#{_\ 4513}# #{tmp\ 4507}#)) + (list->vector #{x\ 4504}#))) + #{tmp\ 4502}#) + (let ((#{_\ 4507}# #{tmp\ 4501}#)) (letrec* - ((#{f\ 4517}# - (lambda (#{y\ 4518}# #{k\ 4519}#) - (let ((#{tmp\ 4530}# #{y\ 4518}#)) - (let ((#{tmp\ 4531}# + ((#{f\ 4511}# + (lambda (#{y\ 4512}# #{k\ 4513}#) + (let ((#{tmp\ 4524}# #{y\ 4512}#)) + (let ((#{tmp\ 4525}# ($sc-dispatch - #{tmp\ 4530}# + #{tmp\ 4524}# '(#(atom "quote") each-any)))) - (if #{tmp\ 4531}# + (if #{tmp\ 4525}# (@apply - (lambda (#{y\ 4533}#) - (#{k\ 4519}# - (map (lambda (#{tmp\ 4534}#) + (lambda (#{y\ 4527}#) + (#{k\ 4513}# + (map (lambda (#{tmp\ 4528}#) (list '#(syntax-object "quote" ((top) #(ribcage #(y) #((top)) - #("i4532")) + #("i4526")) #(ribcage () () ()) #(ribcage #(f y k) #((top) (top) (top)) - #("i4514" - "i4515" - "i4516")) + #("i4508" + "i4509" + "i4510")) #(ribcage #(_) #((top)) - #("i4512")) + #("i4506")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4506")) + #("i4500")) #(ribcage (emit quasivector quasilist* @@ -17084,74 +17098,74 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{tmp\ 4534}#)) - #{y\ 4533}#))) - #{tmp\ 4531}#) - (let ((#{tmp\ 4535}# + #{tmp\ 4528}#)) + #{y\ 4527}#))) + #{tmp\ 4525}#) + (let ((#{tmp\ 4529}# ($sc-dispatch - #{tmp\ 4530}# + #{tmp\ 4524}# '(#(atom "list") . each-any)))) - (if #{tmp\ 4535}# + (if #{tmp\ 4529}# (@apply - (lambda (#{y\ 4537}#) - (#{k\ 4519}# #{y\ 4537}#)) - #{tmp\ 4535}#) - (let ((#{tmp\ 4539}# + (lambda (#{y\ 4531}#) + (#{k\ 4513}# #{y\ 4531}#)) + #{tmp\ 4529}#) + (let ((#{tmp\ 4533}# ($sc-dispatch - #{tmp\ 4530}# + #{tmp\ 4524}# '(#(atom "list*") . #(each+ any (any) ()))))) - (if #{tmp\ 4539}# + (if #{tmp\ 4533}# (@apply - (lambda (#{y\ 4542}# #{z\ 4543}#) - (#{f\ 4517}# - #{z\ 4543}# - (lambda (#{ls\ 4544}#) - (#{k\ 4519}# + (lambda (#{y\ 4536}# #{z\ 4537}#) + (#{f\ 4511}# + #{z\ 4537}# + (lambda (#{ls\ 4538}#) + (#{k\ 4513}# (append - #{y\ 4542}# - #{ls\ 4544}#))))) - #{tmp\ 4539}#) - (let ((#{else\ 4548}# #{tmp\ 4530}#)) - (let ((#{tmp\ 4552}# #{x\ 4505}#)) - (let ((#{\ g4549\ 4554}# - #{tmp\ 4552}#)) + #{y\ 4536}# + #{ls\ 4538}#))))) + #{tmp\ 4533}#) + (let ((#{else\ 4542}# #{tmp\ 4524}#)) + (let ((#{tmp\ 4546}# #{x\ 4499}#)) + (let ((#{\ g4543\ 4548}# + #{tmp\ 4546}#)) (list '#(syntax-object "list->vector" ((top) #(ribcage - #(#{\ g4549}#) - #((m4550 top)) - #("i4553")) + #(#{\ g4543}#) + #((m4544 top)) + #("i4547")) #(ribcage #(else) #((top)) - #("i4547")) + #("i4541")) #(ribcage () () ()) #(ribcage #(f y k) #((top) (top) (top)) - #("i4514" - "i4515" - "i4516")) + #("i4508" + "i4509" + "i4510")) #(ribcage #(_) #((top)) - #("i4512")) + #("i4506")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4506")) + #("i4500")) #(ribcage (emit quasivector quasilist* @@ -17166,48 +17180,48 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4549\ 4554}#)))))))))))))) + #{\ g4543\ 4548}#)))))))))))))) (begin - (#{f\ 4517}# - #{x\ 4505}# - (lambda (#{ls\ 4520}#) - (let ((#{tmp\ 4525}# #{ls\ 4520}#)) - (let ((#{tmp\ 4526}# - ($sc-dispatch #{tmp\ 4525}# 'each-any))) - (if #{tmp\ 4526}# + (#{f\ 4511}# + #{x\ 4499}# + (lambda (#{ls\ 4514}#) + (let ((#{tmp\ 4519}# #{ls\ 4514}#)) + (let ((#{tmp\ 4520}# + ($sc-dispatch #{tmp\ 4519}# 'each-any))) + (if #{tmp\ 4520}# (@apply - (lambda (#{\ g4522\ 4528}#) + (lambda (#{\ g4516\ 4522}#) (cons '#(syntax-object "vector" ((top) #(ribcage - #(#{\ g4522}#) - #((m4523 top)) - #("i4527")) + #(#{\ g4516}#) + #((m4517 top)) + #("i4521")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ls) #((top)) - #("i4521")) + #("i4515")) #(ribcage #(_) #((top)) - #("i4512")) + #("i4506")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4506")) + #("i4500")) #(ribcage (emit quasivector quasilist* @@ -17222,36 +17236,36 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4522\ 4528}#)) - #{tmp\ 4526}#) + #{\ g4516\ 4522}#)) + #{tmp\ 4520}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4525}#)))))))))))))) - (#{emit\ 4378}# - (lambda (#{x\ 4555}#) - (let ((#{tmp\ 4557}# #{x\ 4555}#)) - (let ((#{tmp\ 4558}# + #{tmp\ 4519}#)))))))))))))) + (#{emit\ 4372}# + (lambda (#{x\ 4549}#) + (let ((#{tmp\ 4551}# #{x\ 4549}#)) + (let ((#{tmp\ 4552}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "quote") any)))) - (if #{tmp\ 4558}# + (if #{tmp\ 4552}# (@apply - (lambda (#{x\ 4560}#) + (lambda (#{x\ 4554}#) (list '#(syntax-object quote ((top) - #(ribcage #(x) #((top)) #("i4559")) + #(ribcage #(x) #((top)) #("i4553")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4556")) + #(ribcage #(x) #((top)) #("i4550")) #(ribcage (emit quasivector quasilist* @@ -17260,46 +17274,46 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{x\ 4560}#)) - #{tmp\ 4558}#) - (let ((#{tmp\ 4561}# + #{x\ 4554}#)) + #{tmp\ 4552}#) + (let ((#{tmp\ 4555}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "list") . each-any)))) - (if #{tmp\ 4561}# + (if #{tmp\ 4555}# (@apply - (lambda (#{x\ 4563}#) - (let ((#{tmp\ 4567}# - (map #{emit\ 4378}# #{x\ 4563}#))) - (let ((#{tmp\ 4568}# - ($sc-dispatch #{tmp\ 4567}# 'each-any))) - (if #{tmp\ 4568}# + (lambda (#{x\ 4557}#) + (let ((#{tmp\ 4561}# + (map #{emit\ 4372}# #{x\ 4557}#))) + (let ((#{tmp\ 4562}# + ($sc-dispatch #{tmp\ 4561}# 'each-any))) + (if #{tmp\ 4562}# (@apply - (lambda (#{\ g4564\ 4570}#) + (lambda (#{\ g4558\ 4564}#) (cons '#(syntax-object list ((top) #(ribcage - #(#{\ g4564}#) - #((m4565 top)) - #("i4569")) - #(ribcage - #(x) - #((top)) - #("i4562")) - #(ribcage () () ()) + #(#{\ g4558}#) + #((m4559 top)) + #("i4563")) #(ribcage #(x) #((top)) #("i4556")) + #(ribcage () () ()) + #(ribcage + #(x) + #((top)) + #("i4550")) #(ribcage (emit quasivector quasilist* @@ -17314,69 +17328,69 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4564\ 4570}#)) - #{tmp\ 4568}#) + #{\ g4558\ 4564}#)) + #{tmp\ 4562}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4567}#))))) - #{tmp\ 4561}#) - (let ((#{tmp\ 4573}# + #{tmp\ 4561}#))))) + #{tmp\ 4555}#) + (let ((#{tmp\ 4567}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "list*") . #(each+ any (any) ()))))) - (if #{tmp\ 4573}# + (if #{tmp\ 4567}# (@apply - (lambda (#{x\ 4576}# #{y\ 4577}#) + (lambda (#{x\ 4570}# #{y\ 4571}#) (letrec* - ((#{f\ 4580}# - (lambda (#{x*\ 4581}#) - (if (null? #{x*\ 4581}#) - (#{emit\ 4378}# #{y\ 4577}#) - (let ((#{tmp\ 4587}# - (list (#{emit\ 4378}# - (car #{x*\ 4581}#)) - (#{f\ 4580}# - (cdr #{x*\ 4581}#))))) - (let ((#{tmp\ 4588}# + ((#{f\ 4574}# + (lambda (#{x*\ 4575}#) + (if (null? #{x*\ 4575}#) + (#{emit\ 4372}# #{y\ 4571}#) + (let ((#{tmp\ 4581}# + (list (#{emit\ 4372}# + (car #{x*\ 4575}#)) + (#{f\ 4574}# + (cdr #{x*\ 4575}#))))) + (let ((#{tmp\ 4582}# ($sc-dispatch - #{tmp\ 4587}# + #{tmp\ 4581}# '(any any)))) - (if #{tmp\ 4588}# + (if #{tmp\ 4582}# (@apply - (lambda (#{\ g4584\ 4591}# - #{\ g4583\ 4592}#) + (lambda (#{\ g4578\ 4585}# + #{\ g4577\ 4586}#) (list '#(syntax-object cons ((top) #(ribcage - #(#{\ g4584}# - #{\ g4583}#) - #((m4585 top) - (m4585 top)) - #("i4589" "i4590")) + #(#{\ g4578}# + #{\ g4577}#) + #((m4579 top) + (m4579 top)) + #("i4583" "i4584")) #(ribcage () () ()) #(ribcage #(f x*) #((top) (top)) - #("i4578" "i4579")) + #("i4572" "i4573")) #(ribcage #(x y) #((top) (top)) - #("i4574" "i4575")) + #("i4568" "i4569")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4556")) + #("i4550")) #(ribcage (emit quasivector quasilist* @@ -17391,55 +17405,55 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4584\ 4591}# - #{\ g4583\ 4592}#)) - #{tmp\ 4588}#) + #{\ g4578\ 4585}# + #{\ g4577\ 4586}#)) + #{tmp\ 4582}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4587}#)))))))) - (begin (#{f\ 4580}# #{x\ 4576}#)))) - #{tmp\ 4573}#) - (let ((#{tmp\ 4593}# + #{tmp\ 4581}#)))))))) + (begin (#{f\ 4574}# #{x\ 4570}#)))) + #{tmp\ 4567}#) + (let ((#{tmp\ 4587}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "append") . each-any)))) - (if #{tmp\ 4593}# + (if #{tmp\ 4587}# (@apply - (lambda (#{x\ 4595}#) - (let ((#{tmp\ 4599}# - (map #{emit\ 4378}# #{x\ 4595}#))) - (let ((#{tmp\ 4600}# + (lambda (#{x\ 4589}#) + (let ((#{tmp\ 4593}# + (map #{emit\ 4372}# #{x\ 4589}#))) + (let ((#{tmp\ 4594}# ($sc-dispatch - #{tmp\ 4599}# + #{tmp\ 4593}# 'each-any))) - (if #{tmp\ 4600}# + (if #{tmp\ 4594}# (@apply - (lambda (#{\ g4596\ 4602}#) + (lambda (#{\ g4590\ 4596}#) (cons '#(syntax-object append ((top) #(ribcage - #(#{\ g4596}#) - #((m4597 top)) - #("i4601")) + #(#{\ g4590}#) + #((m4591 top)) + #("i4595")) #(ribcage #(x) #((top)) - #("i4594")) + #("i4588")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4556")) + #("i4550")) #(ribcage (emit quasivector quasilist* @@ -17454,53 +17468,53 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4596\ 4602}#)) - #{tmp\ 4600}#) + #{\ g4590\ 4596}#)) + #{tmp\ 4594}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4599}#))))) - #{tmp\ 4593}#) - (let ((#{tmp\ 4605}# + #{tmp\ 4593}#))))) + #{tmp\ 4587}#) + (let ((#{tmp\ 4599}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "vector") . each-any)))) - (if #{tmp\ 4605}# + (if #{tmp\ 4599}# (@apply - (lambda (#{x\ 4607}#) - (let ((#{tmp\ 4611}# - (map #{emit\ 4378}# #{x\ 4607}#))) - (let ((#{tmp\ 4612}# + (lambda (#{x\ 4601}#) + (let ((#{tmp\ 4605}# + (map #{emit\ 4372}# #{x\ 4601}#))) + (let ((#{tmp\ 4606}# ($sc-dispatch - #{tmp\ 4611}# + #{tmp\ 4605}# 'each-any))) - (if #{tmp\ 4612}# + (if #{tmp\ 4606}# (@apply - (lambda (#{\ g4608\ 4614}#) + (lambda (#{\ g4602\ 4608}#) (cons '#(syntax-object vector ((top) #(ribcage - #(#{\ g4608}#) - #((m4609 top)) - #("i4613")) + #(#{\ g4602}#) + #((m4603 top)) + #("i4607")) #(ribcage #(x) #((top)) - #("i4606")) + #("i4600")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4556")) + #("i4550")) #(ribcage (emit quasivector quasilist* @@ -17515,48 +17529,48 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4608\ 4614}#)) - #{tmp\ 4612}#) + #{\ g4602\ 4608}#)) + #{tmp\ 4606}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4611}#))))) - #{tmp\ 4605}#) - (let ((#{tmp\ 4617}# + #{tmp\ 4605}#))))) + #{tmp\ 4599}#) + (let ((#{tmp\ 4611}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "list->vector") any)))) - (if #{tmp\ 4617}# + (if #{tmp\ 4611}# (@apply - (lambda (#{x\ 4619}#) - (let ((#{tmp\ 4623}# - (#{emit\ 4378}# #{x\ 4619}#))) - (let ((#{\ g4620\ 4625}# - #{tmp\ 4623}#)) + (lambda (#{x\ 4613}#) + (let ((#{tmp\ 4617}# + (#{emit\ 4372}# #{x\ 4613}#))) + (let ((#{\ g4614\ 4619}# + #{tmp\ 4617}#)) (list '#(syntax-object list->vector ((top) #(ribcage - #(#{\ g4620}#) - #((m4621 top)) - #("i4624")) + #(#{\ g4614}#) + #((m4615 top)) + #("i4618")) #(ribcage #(x) #((top)) - #("i4618")) + #("i4612")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4556")) + #("i4550")) #(ribcage (emit quasivector quasilist* @@ -17571,211 +17585,211 @@ (top) (top) (top)) - ("i4377" - "i4375" - "i4373" - "i4371" + ("i4371" "i4369" "i4367" - "i4365"))) + "i4365" + "i4363" + "i4361" + "i4359"))) (hygiene guile)) - #{\ g4620\ 4625}#)))) - #{tmp\ 4617}#) - (let ((#{tmp\ 4626}# + #{\ g4614\ 4619}#)))) + #{tmp\ 4611}#) + (let ((#{tmp\ 4620}# ($sc-dispatch - #{tmp\ 4557}# + #{tmp\ 4551}# '(#(atom "value") any)))) - (if #{tmp\ 4626}# + (if #{tmp\ 4620}# (@apply - (lambda (#{x\ 4628}#) #{x\ 4628}#) - #{tmp\ 4626}#) + (lambda (#{x\ 4622}#) #{x\ 4622}#) + #{tmp\ 4620}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4557}#))))))))))))))))))) + #{tmp\ 4551}#))))))))))))))))))) (begin - (lambda (#{x\ 4629}#) - (let ((#{tmp\ 4631}# #{x\ 4629}#)) - (let ((#{tmp\ 4632}# - ($sc-dispatch #{tmp\ 4631}# '(_ any)))) - (if #{tmp\ 4632}# + (lambda (#{x\ 4623}#) + (let ((#{tmp\ 4625}# #{x\ 4623}#)) + (let ((#{tmp\ 4626}# + ($sc-dispatch #{tmp\ 4625}# '(_ any)))) + (if #{tmp\ 4626}# (@apply - (lambda (#{e\ 4634}#) - (#{emit\ 4378}# (#{quasi\ 4366}# #{e\ 4634}# 0))) - #{tmp\ 4632}#) + (lambda (#{e\ 4628}#) + (#{emit\ 4372}# (#{quasi\ 4360}# #{e\ 4628}# 0))) + #{tmp\ 4626}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4631}#))))))))) + #{tmp\ 4625}#))))))))) (define include (make-syntax-transformer 'include 'macro - (lambda (#{x\ 4635}#) + (lambda (#{x\ 4629}#) (letrec* - ((#{read-file\ 4638}# - (lambda (#{fn\ 4639}# #{k\ 4640}#) + ((#{read-file\ 4632}# + (lambda (#{fn\ 4633}# #{k\ 4634}#) (begin - (let ((#{p\ 4644}# (open-input-file #{fn\ 4639}#))) + (let ((#{p\ 4638}# (open-input-file #{fn\ 4633}#))) (letrec* - ((#{f\ 4648}# - (lambda (#{x\ 4649}# #{result\ 4650}#) - (if (eof-object? #{x\ 4649}#) + ((#{f\ 4642}# + (lambda (#{x\ 4643}# #{result\ 4644}#) + (if (eof-object? #{x\ 4643}#) (begin - (close-input-port #{p\ 4644}#) - (reverse #{result\ 4650}#)) - (#{f\ 4648}# - (read #{p\ 4644}#) - (cons (datum->syntax #{k\ 4640}# #{x\ 4649}#) - #{result\ 4650}#)))))) - (begin (#{f\ 4648}# (read #{p\ 4644}#) '())))))))) + (close-input-port #{p\ 4638}#) + (reverse #{result\ 4644}#)) + (#{f\ 4642}# + (read #{p\ 4638}#) + (cons (datum->syntax #{k\ 4634}# #{x\ 4643}#) + #{result\ 4644}#)))))) + (begin (#{f\ 4642}# (read #{p\ 4638}#) '())))))))) (begin - (let ((#{tmp\ 4651}# #{x\ 4635}#)) - (let ((#{tmp\ 4652}# - ($sc-dispatch #{tmp\ 4651}# '(any any)))) - (if #{tmp\ 4652}# + (let ((#{tmp\ 4645}# #{x\ 4629}#)) + (let ((#{tmp\ 4646}# + ($sc-dispatch #{tmp\ 4645}# '(any any)))) + (if #{tmp\ 4646}# (@apply - (lambda (#{k\ 4655}# #{filename\ 4656}#) + (lambda (#{k\ 4649}# #{filename\ 4650}#) (begin - (let ((#{fn\ 4658}# (syntax->datum #{filename\ 4656}#))) - (let ((#{tmp\ 4660}# - (#{read-file\ 4638}# - #{fn\ 4658}# - #{filename\ 4656}#))) - (let ((#{tmp\ 4661}# - ($sc-dispatch #{tmp\ 4660}# 'each-any))) - (if #{tmp\ 4661}# + (let ((#{fn\ 4652}# (syntax->datum #{filename\ 4650}#))) + (let ((#{tmp\ 4654}# + (#{read-file\ 4632}# + #{fn\ 4652}# + #{filename\ 4650}#))) + (let ((#{tmp\ 4655}# + ($sc-dispatch #{tmp\ 4654}# 'each-any))) + (if #{tmp\ 4655}# (@apply - (lambda (#{exp\ 4663}#) + (lambda (#{exp\ 4657}#) (cons '#(syntax-object begin ((top) #(ribcage #(exp) #((top)) - #("i4662")) + #("i4656")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) - #("i4657")) + #("i4651")) #(ribcage #(k filename) #((top) (top)) - #("i4653" "i4654")) + #("i4647" "i4648")) #(ribcage (read-file) ((top)) - ("i4637")) + ("i4631")) #(ribcage #(x) #((top)) - #("i4636"))) + #("i4630"))) (hygiene guile)) - #{exp\ 4663}#)) - #{tmp\ 4661}#) + #{exp\ 4657}#)) + #{tmp\ 4655}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4660}#))))))) - #{tmp\ 4652}#) + #{tmp\ 4654}#))))))) + #{tmp\ 4646}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4651}#))))))))) + #{tmp\ 4645}#))))))))) (define include-from-path (make-syntax-transformer 'include-from-path 'macro - (lambda (#{x\ 4665}#) - (let ((#{tmp\ 4667}# #{x\ 4665}#)) - (let ((#{tmp\ 4668}# - ($sc-dispatch #{tmp\ 4667}# '(any any)))) - (if #{tmp\ 4668}# + (lambda (#{x\ 4659}#) + (let ((#{tmp\ 4661}# #{x\ 4659}#)) + (let ((#{tmp\ 4662}# + ($sc-dispatch #{tmp\ 4661}# '(any any)))) + (if #{tmp\ 4662}# (@apply - (lambda (#{k\ 4671}# #{filename\ 4672}#) + (lambda (#{k\ 4665}# #{filename\ 4666}#) (begin - (let ((#{fn\ 4674}# (syntax->datum #{filename\ 4672}#))) - (let ((#{tmp\ 4676}# + (let ((#{fn\ 4668}# (syntax->datum #{filename\ 4666}#))) + (let ((#{tmp\ 4670}# (datum->syntax - #{filename\ 4672}# + #{filename\ 4666}# (begin - (let ((#{t\ 4681}# - (%search-load-path #{fn\ 4674}#))) - (if #{t\ 4681}# - #{t\ 4681}# + (let ((#{t\ 4675}# + (%search-load-path #{fn\ 4668}#))) + (if #{t\ 4675}# + #{t\ 4675}# (syntax-violation 'include-from-path "file not found in path" - #{x\ 4665}# - #{filename\ 4672}#))))))) - (let ((#{fn\ 4678}# #{tmp\ 4676}#)) + #{x\ 4659}# + #{filename\ 4666}#))))))) + (let ((#{fn\ 4672}# #{tmp\ 4670}#)) (list '#(syntax-object include ((top) - #(ribcage #(fn) #((top)) #("i4677")) + #(ribcage #(fn) #((top)) #("i4671")) #(ribcage () () ()) #(ribcage () () ()) - #(ribcage #(fn) #((top)) #("i4673")) + #(ribcage #(fn) #((top)) #("i4667")) #(ribcage #(k filename) #((top) (top)) - #("i4669" "i4670")) + #("i4663" "i4664")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4666"))) + #(ribcage #(x) #((top)) #("i4660"))) (hygiene guile)) - #{fn\ 4678}#)))))) - #{tmp\ 4668}#) + #{fn\ 4672}#)))))) + #{tmp\ 4662}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4667}#))))))) + #{tmp\ 4661}#))))))) (define unquote (make-syntax-transformer 'unquote 'macro - (lambda (#{x\ 4683}#) + (lambda (#{x\ 4677}#) (syntax-violation 'unquote "expression not valid outside of quasiquote" - #{x\ 4683}#)))) + #{x\ 4677}#)))) (define unquote-splicing (make-syntax-transformer 'unquote-splicing 'macro - (lambda (#{x\ 4685}#) + (lambda (#{x\ 4679}#) (syntax-violation 'unquote-splicing "expression not valid outside of quasiquote" - #{x\ 4685}#)))) + #{x\ 4679}#)))) (define case (make-syntax-transformer 'case 'macro - (lambda (#{x\ 4687}#) - (let ((#{tmp\ 4689}# #{x\ 4687}#)) - (let ((#{tmp\ 4690}# + (lambda (#{x\ 4681}#) + (let ((#{tmp\ 4683}# #{x\ 4681}#)) + (let ((#{tmp\ 4684}# ($sc-dispatch - #{tmp\ 4689}# + #{tmp\ 4683}# '(_ any any . each-any)))) - (if #{tmp\ 4690}# + (if #{tmp\ 4684}# (@apply - (lambda (#{e\ 4694}# #{m1\ 4695}# #{m2\ 4696}#) - (let ((#{tmp\ 4698}# + (lambda (#{e\ 4688}# #{m1\ 4689}# #{m2\ 4690}#) + (let ((#{tmp\ 4692}# (letrec* - ((#{f\ 4704}# - (lambda (#{clause\ 4705}# #{clauses\ 4706}#) - (if (null? #{clauses\ 4706}#) - (let ((#{tmp\ 4708}# #{clause\ 4705}#)) - (let ((#{tmp\ 4709}# + ((#{f\ 4698}# + (lambda (#{clause\ 4699}# #{clauses\ 4700}#) + (if (null? #{clauses\ 4700}#) + (let ((#{tmp\ 4702}# #{clause\ 4699}#)) + (let ((#{tmp\ 4703}# ($sc-dispatch - #{tmp\ 4708}# + #{tmp\ 4702}# '(#(free-id #(syntax-object else @@ -17784,92 +17798,92 @@ #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile))) any . each-any)))) - (if #{tmp\ 4709}# + (if #{tmp\ 4703}# (@apply - (lambda (#{e1\ 4712}# #{e2\ 4713}#) + (lambda (#{e1\ 4706}# #{e2\ 4707}#) (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4710" "i4711")) + #("i4704" "i4705")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) - (cons #{e1\ 4712}# - #{e2\ 4713}#))) - #{tmp\ 4709}#) - (let ((#{tmp\ 4715}# + (cons #{e1\ 4706}# + #{e2\ 4707}#))) + #{tmp\ 4703}#) + (let ((#{tmp\ 4709}# ($sc-dispatch - #{tmp\ 4708}# + #{tmp\ 4702}# '(each-any any . each-any)))) - (if #{tmp\ 4715}# + (if #{tmp\ 4709}# (@apply - (lambda (#{k\ 4719}# - #{e1\ 4720}# - #{e2\ 4721}#) + (lambda (#{k\ 4713}# + #{e1\ 4714}# + #{e2\ 4715}#) (list '#(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) - #("i4716" - "i4717" - "i4718")) + #("i4710" + "i4711" + "i4712")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) (list '#(syntax-object memv @@ -17879,9 +17893,9 @@ #((top) (top) (top)) - #("i4716" - "i4717" - "i4718")) + #("i4710" + "i4711" + "i4712")) #(ribcage () () @@ -17893,17 +17907,17 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -17911,7 +17925,7 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) '#(syntax-object t @@ -17921,9 +17935,9 @@ #((top) (top) (top)) - #("i4716" - "i4717" - "i4718")) + #("i4710" + "i4711" + "i4712")) #(ribcage () () @@ -17935,17 +17949,17 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -17953,7 +17967,7 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) (list '#(syntax-object quote @@ -17965,9 +17979,9 @@ #((top) (top) (top)) - #("i4716" - "i4717" - "i4718")) + #("i4710" + "i4711" + "i4712")) #(ribcage () () @@ -17979,9 +17993,9 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 @@ -17989,9 +18003,9 @@ #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -17999,10 +18013,10 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) - #{k\ 4719}#)) + #{k\ 4713}#)) (cons '#(syntax-object begin ((top) @@ -18011,9 +18025,9 @@ #((top) (top) (top)) - #("i4716" - "i4717" - "i4718")) + #("i4710" + "i4711" + "i4712")) #(ribcage () () @@ -18025,17 +18039,17 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -18043,63 +18057,63 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) - (cons #{e1\ 4720}# - #{e2\ 4721}#)))) - #{tmp\ 4715}#) - (let ((#{_\ 4725}# #{tmp\ 4708}#)) + (cons #{e1\ 4714}# + #{e2\ 4715}#)))) + #{tmp\ 4709}#) + (let ((#{_\ 4719}# #{tmp\ 4702}#)) (syntax-violation 'case "bad clause" - #{x\ 4687}# - #{clause\ 4705}#))))))) - (let ((#{tmp\ 4727}# - (#{f\ 4704}# - (car #{clauses\ 4706}#) - (cdr #{clauses\ 4706}#)))) - (let ((#{rest\ 4729}# #{tmp\ 4727}#)) - (let ((#{tmp\ 4730}# #{clause\ 4705}#)) - (let ((#{tmp\ 4731}# + #{x\ 4681}# + #{clause\ 4699}#))))))) + (let ((#{tmp\ 4721}# + (#{f\ 4698}# + (car #{clauses\ 4700}#) + (cdr #{clauses\ 4700}#)))) + (let ((#{rest\ 4723}# #{tmp\ 4721}#)) + (let ((#{tmp\ 4724}# #{clause\ 4699}#)) + (let ((#{tmp\ 4725}# ($sc-dispatch - #{tmp\ 4730}# + #{tmp\ 4724}# '(each-any any . each-any)))) - (if #{tmp\ 4731}# + (if #{tmp\ 4725}# (@apply - (lambda (#{k\ 4735}# - #{e1\ 4736}# - #{e2\ 4737}#) + (lambda (#{k\ 4729}# + #{e1\ 4730}# + #{e2\ 4731}#) (list '#(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) - #("i4732" - "i4733" - "i4734")) + #("i4726" + "i4727" + "i4728")) #(ribcage #(rest) #((top)) - #("i4728")) + #("i4722")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) (list '#(syntax-object memv @@ -18109,13 +18123,13 @@ #((top) (top) (top)) - #("i4732" - "i4733" - "i4734")) + #("i4726" + "i4727" + "i4728")) #(ribcage #(rest) #((top)) - #("i4728")) + #("i4722")) #(ribcage () () @@ -18127,17 +18141,17 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -18145,7 +18159,7 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) '#(syntax-object t @@ -18155,13 +18169,13 @@ #((top) (top) (top)) - #("i4732" - "i4733" - "i4734")) + #("i4726" + "i4727" + "i4728")) #(ribcage #(rest) #((top)) - #("i4728")) + #("i4722")) #(ribcage () () @@ -18173,17 +18187,17 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -18191,7 +18205,7 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) (list '#(syntax-object quote @@ -18203,13 +18217,13 @@ #((top) (top) (top)) - #("i4732" - "i4733" - "i4734")) + #("i4726" + "i4727" + "i4728")) #(ribcage #(rest) #((top)) - #("i4728")) + #("i4722")) #(ribcage () () @@ -18221,9 +18235,9 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 @@ -18231,9 +18245,9 @@ #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -18241,10 +18255,10 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) - #{k\ 4735}#)) + #{k\ 4729}#)) (cons '#(syntax-object begin ((top) @@ -18253,13 +18267,13 @@ #((top) (top) (top)) - #("i4732" - "i4733" - "i4734")) + #("i4726" + "i4727" + "i4728")) #(ribcage #(rest) #((top)) - #("i4728")) + #("i4722")) #(ribcage () () @@ -18271,17 +18285,17 @@ #((top) (top) (top)) - #("i4701" - "i4702" - "i4703")) + #("i4695" + "i4696" + "i4697")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" - "i4692" - "i4693")) + #("i4685" + "i4686" + "i4687")) #(ribcage () () @@ -18289,30 +18303,30 @@ #(ribcage #(x) #((top)) - #("i4688"))) + #("i4682"))) (hygiene guile)) - (cons #{e1\ 4736}# - #{e2\ 4737}#)) - #{rest\ 4729}#)) - #{tmp\ 4731}#) - (let ((#{_\ 4741}# #{tmp\ 4730}#)) + (cons #{e1\ 4730}# + #{e2\ 4731}#)) + #{rest\ 4723}#)) + #{tmp\ 4725}#) + (let ((#{_\ 4735}# #{tmp\ 4724}#)) (syntax-violation 'case "bad clause" - #{x\ 4687}# - #{clause\ 4705}#))))))))))) - (begin (#{f\ 4704}# #{m1\ 4695}# #{m2\ 4696}#))))) - (let ((#{body\ 4700}# #{tmp\ 4698}#)) + #{x\ 4681}# + #{clause\ 4699}#))))))))))) + (begin (#{f\ 4698}# #{m1\ 4689}# #{m2\ 4690}#))))) + (let ((#{body\ 4694}# #{tmp\ 4692}#)) (list '#(syntax-object let ((top) - #(ribcage #(body) #((top)) #("i4699")) + #(ribcage #(body) #((top)) #("i4693")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" "i4692" "i4693")) + #("i4685" "i4686" "i4687")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4688"))) + #(ribcage #(x) #((top)) #("i4682"))) (hygiene guile)) (list (list '#(syntax-object t @@ -18320,177 +18334,177 @@ #(ribcage #(body) #((top)) - #("i4699")) + #("i4693")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4691" "i4692" "i4693")) + #("i4685" "i4686" "i4687")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4688"))) + #(ribcage #(x) #((top)) #("i4682"))) (hygiene guile)) - #{e\ 4694}#)) - #{body\ 4700}#)))) - #{tmp\ 4690}#) + #{e\ 4688}#)) + #{body\ 4694}#)))) + #{tmp\ 4684}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4689}#))))))) + #{tmp\ 4683}#))))))) (define make-variable-transformer - (lambda (#{proc\ 4742}#) - (if (procedure? #{proc\ 4742}#) + (lambda (#{proc\ 4736}#) + (if (procedure? #{proc\ 4736}#) (begin (letrec* - ((#{trans\ 4745}# - (lambda (#{x\ 4746}#) - (#{proc\ 4742}# #{x\ 4746}#)))) + ((#{trans\ 4739}# + (lambda (#{x\ 4740}#) + (#{proc\ 4736}# #{x\ 4740}#)))) (begin (set-procedure-property! - #{trans\ 4745}# + #{trans\ 4739}# 'variable-transformer #t) - #{trans\ 4745}#))) + #{trans\ 4739}#))) (error "variable transformer not a procedure" - #{proc\ 4742}#)))) + #{proc\ 4736}#)))) (define identifier-syntax (make-syntax-transformer 'identifier-syntax 'macro - (lambda (#{x\ 4748}#) - (let ((#{tmp\ 4750}# #{x\ 4748}#)) - (let ((#{tmp\ 4751}# - ($sc-dispatch #{tmp\ 4750}# '(_ any)))) - (if #{tmp\ 4751}# + (lambda (#{x\ 4742}#) + (let ((#{tmp\ 4744}# #{x\ 4742}#)) + (let ((#{tmp\ 4745}# + ($sc-dispatch #{tmp\ 4744}# '(_ any)))) + (if #{tmp\ 4745}# (@apply - (lambda (#{e\ 4753}#) + (lambda (#{e\ 4747}#) (list '#(syntax-object lambda ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '(#(syntax-object x ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile))) '#((#(syntax-object macro-type ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) . #(syntax-object identifier-syntax ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)))) (list '#(syntax-object syntax-case ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '#(syntax-object x ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '() (list '#(syntax-object id ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '(#(syntax-object identifier? ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) (#(syntax-object syntax ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) #(syntax-object id ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)))) (list '#(syntax-object syntax ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - #{e\ 4753}#)) + #{e\ 4747}#)) (list '(#(syntax-object _ ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) #(syntax-object x ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) #(syntax-object ... ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile))) (list '#(syntax-object syntax ((top) - #(ribcage #(e) #((top)) #("i4752")) + #(ribcage #(e) #((top)) #("i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - (cons #{e\ 4753}# + (cons #{e\ 4747}# '(#(syntax-object x ((top) #(ribcage #(e) #((top)) - #("i4752")) + #("i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) #(syntax-object ... @@ -18498,55 +18512,55 @@ #(ribcage #(e) #((top)) - #("i4752")) + #("i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile))))))))) - #{tmp\ 4751}#) - (let ((#{tmp\ 4754}# + #{tmp\ 4745}#) + (let ((#{tmp\ 4748}# ($sc-dispatch - #{tmp\ 4750}# + #{tmp\ 4744}# '(_ (any any) ((#(free-id #(syntax-object set! ((top) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile))) any any) any))))) - (if (if #{tmp\ 4754}# + (if (if #{tmp\ 4748}# (@apply - (lambda (#{id\ 4760}# - #{exp1\ 4761}# - #{var\ 4762}# - #{val\ 4763}# - #{exp2\ 4764}#) - (if (identifier? #{id\ 4760}#) - (identifier? #{var\ 4762}#) + (lambda (#{id\ 4754}# + #{exp1\ 4755}# + #{var\ 4756}# + #{val\ 4757}# + #{exp2\ 4758}#) + (if (identifier? #{id\ 4754}#) + (identifier? #{var\ 4756}#) #f)) - #{tmp\ 4754}#) + #{tmp\ 4748}#) #f) (@apply - (lambda (#{id\ 4772}# - #{exp1\ 4773}# - #{var\ 4774}# - #{val\ 4775}# - #{exp2\ 4776}#) + (lambda (#{id\ 4766}# + #{exp1\ 4767}# + #{var\ 4768}# + #{val\ 4769}# + #{exp2\ 4770}#) (list '#(syntax-object make-variable-transformer ((top) #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" "i4768" "i4769" "i4770" "i4771")) + #("i4761" "i4762" "i4763" "i4764" "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) (list '#(syntax-object lambda @@ -18554,13 +18568,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '(#(syntax-object x @@ -18568,13 +18582,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile))) '#((#(syntax-object macro-type @@ -18582,13 +18596,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) . #(syntax-object @@ -18597,13 +18611,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)))) (list '#(syntax-object syntax-case @@ -18611,13 +18625,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '#(syntax-object x @@ -18625,13 +18639,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile)) '(#(syntax-object set! @@ -18639,13 +18653,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4749"))) + #(ribcage #(x) #((top)) #("i4743"))) (hygiene guile))) (list (list '#(syntax-object set! @@ -18657,19 +18671,19 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - #{var\ 4774}# - #{val\ 4775}#) + #{var\ 4768}# + #{val\ 4769}#) (list '#(syntax-object syntax ((top) @@ -18680,19 +18694,19 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - #{exp2\ 4776}#)) - (list (cons #{id\ 4772}# + #{exp2\ 4770}#)) + (list (cons #{id\ 4766}# '(#(syntax-object x ((top) @@ -18707,16 +18721,16 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) #(syntax-object ... @@ -18732,16 +18746,16 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)))) (list '#(syntax-object syntax @@ -18753,18 +18767,18 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - (cons #{exp1\ 4773}# + (cons #{exp1\ 4767}# '(#(syntax-object x ((top) @@ -18779,11 +18793,11 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () @@ -18791,7 +18805,7 @@ #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) #(syntax-object ... @@ -18807,11 +18821,11 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () @@ -18819,10 +18833,10 @@ #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)))))) - (list #{id\ 4772}# + (list #{id\ 4766}# (list '#(syntax-object identifier? ((top) @@ -18833,16 +18847,16 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) (list '#(syntax-object syntax @@ -18858,18 +18872,18 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - #{id\ 4772}#)) + #{id\ 4766}#)) (list '#(syntax-object syntax ((top) @@ -18880,69 +18894,69 @@ (top) (top) (top)) - #("i4767" - "i4768" - "i4769" - "i4770" - "i4771")) + #("i4761" + "i4762" + "i4763" + "i4764" + "i4765")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4749"))) + #("i4743"))) (hygiene guile)) - #{exp1\ 4773}#)))))) - #{tmp\ 4754}#) + #{exp1\ 4767}#)))))) + #{tmp\ 4748}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4750}#))))))))) + #{tmp\ 4744}#))))))))) (define define* (make-syntax-transformer 'define* 'macro - (lambda (#{x\ 4777}#) - (let ((#{tmp\ 4779}# #{x\ 4777}#)) - (let ((#{tmp\ 4780}# + (lambda (#{x\ 4771}#) + (let ((#{tmp\ 4773}# #{x\ 4771}#)) + (let ((#{tmp\ 4774}# ($sc-dispatch - #{tmp\ 4779}# + #{tmp\ 4773}# '(_ (any . any) any . each-any)))) - (if #{tmp\ 4780}# + (if #{tmp\ 4774}# (@apply - (lambda (#{id\ 4785}# - #{args\ 4786}# - #{b0\ 4787}# - #{b1\ 4788}#) + (lambda (#{id\ 4779}# + #{args\ 4780}# + #{b0\ 4781}# + #{b1\ 4782}#) (list '#(syntax-object define ((top) #(ribcage #(id args b0 b1) #((top) (top) (top) (top)) - #("i4781" "i4782" "i4783" "i4784")) + #("i4775" "i4776" "i4777" "i4778")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4778"))) + #(ribcage #(x) #((top)) #("i4772"))) (hygiene guile)) - #{id\ 4785}# + #{id\ 4779}# (cons '#(syntax-object lambda* ((top) #(ribcage #(id args b0 b1) #((top) (top) (top) (top)) - #("i4781" "i4782" "i4783" "i4784")) + #("i4775" "i4776" "i4777" "i4778")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4778"))) + #(ribcage #(x) #((top)) #("i4772"))) (hygiene guile)) - (cons #{args\ 4786}# - (cons #{b0\ 4787}# #{b1\ 4788}#))))) - #{tmp\ 4780}#) - (let ((#{tmp\ 4790}# - ($sc-dispatch #{tmp\ 4779}# '(_ any any)))) - (if (if #{tmp\ 4790}# + (cons #{args\ 4780}# + (cons #{b0\ 4781}# #{b1\ 4782}#))))) + #{tmp\ 4774}#) + (let ((#{tmp\ 4784}# + ($sc-dispatch #{tmp\ 4773}# '(_ any any)))) + (if (if #{tmp\ 4784}# (@apply - (lambda (#{id\ 4793}# #{val\ 4794}#) + (lambda (#{id\ 4787}# #{val\ 4788}#) (identifier? '#(syntax-object x @@ -18950,29 +18964,29 @@ #(ribcage #(id val) #((top) (top)) - #("i4791" "i4792")) + #("i4785" "i4786")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4778"))) + #(ribcage #(x) #((top)) #("i4772"))) (hygiene guile)))) - #{tmp\ 4790}#) + #{tmp\ 4784}#) #f) (@apply - (lambda (#{id\ 4797}# #{val\ 4798}#) + (lambda (#{id\ 4791}# #{val\ 4792}#) (list '#(syntax-object define ((top) #(ribcage #(id val) #((top) (top)) - #("i4795" "i4796")) + #("i4789" "i4790")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4778"))) + #(ribcage #(x) #((top)) #("i4772"))) (hygiene guile)) - #{id\ 4797}# - #{val\ 4798}#)) - #{tmp\ 4790}#) + #{id\ 4791}# + #{val\ 4792}#)) + #{tmp\ 4784}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4779}#))))))))) + #{tmp\ 4773}#))))))))) From 450aee6790e325b8fbf1102c3403255bf3fc571f Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 13:07:04 +0100 Subject: [PATCH 048/183] update R6RS incompatibilities * doc/ref/r6rs.texi (R6RS Incompatibilities): Update. --- doc/ref/r6rs.texi | 49 ++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi index 0fb87d142..c1ac54124 100644 --- a/doc/ref/r6rs.texi +++ b/doc/ref/r6rs.texi @@ -38,9 +38,11 @@ does not restore it. This is a bug. @item R6RS unicode escapes within strings are disabled by default, because -they conflict with Guile's already-existing escapes. R6RS behavior can -be turned on via a reader option. @xref{String Syntax}, for more -information. +they conflict with Guile's already-existing escapes. The same is the +case for R6RS treatment of escaped newlines in strings. + +R6RS behavior can be turned on via a reader option. @xref{String +Syntax}, for more information. @item A @code{set!} to a variable transformer may only expand to an @@ -51,23 +53,8 @@ expression was in definition context. Instead of using the algorithm detailed in chapter 10 of the R6RS, expansion of toplevel forms happens sequentially. -For example, while the expansion of the following set of recursive -nested definitions does do the correct thing: - -@example -(let () - (define even? - (lambda (x) - (or (= x 0) (odd? (- x 1))))) - (define-syntax odd? - (syntax-rules () - ((odd? x) (not (even? x))))) - (even? 10)) -@result{} #t -@end example - -@noindent -The same definitions at the toplevel do not: +For example, while the expansion of the following set of toplevel +definitions does the correct thing: @example (begin @@ -78,6 +65,20 @@ The same definitions at the toplevel do not: (syntax-rules () ((odd? x) (not (even? x))))) (even? 10)) +@result{} #t +@end example + +@noindent +The same definitions outside of the @code{begin} wrapper do not: + +@example +(define even? + (lambda (x) + (or (= x 0) (odd? (- x 1))))) +(define-syntax odd? + (syntax-rules () + ((odd? x) (not (even? x))))) +(even? 10) :4:18: In procedure even?: :4:18: Wrong type to apply: # @end example @@ -86,10 +87,10 @@ This is because when expanding the right-hand-side of @code{even?}, the reference to @code{odd?} is not yet marked as a syntax transformer, so it is assumed to be a function. -While it is likely that we can fix the case of toplevel forms nested in -a @code{begin} or a @code{library} form, a fix for toplevel programs -seems trickier to implement in a backward-compatible way. Suggestions -and/or patches would be appreciated. +This bug will only affect top-level programs, not code in @code{library} +forms. Fixing it for toplevel forms seems doable, but tricky to +implement in a backward-compatible way. Suggestions and/or patches would +be appreciated. @item The @code{(rnrs io ports)} module is mostly unimplemented. Work is From 4e33a13246751034adbcc53f9e93223e19f57db2 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 23:15:13 +0100 Subject: [PATCH 049/183] scm-error-printer resilience * module/ice-9/boot-9.scm (scm-error-printer): Allow #f for rest args, interpreting it as '(). Fixes regexp throws, which are of the form: (regular-expression-syntax "make-regexp" "Invalid preceding regular expression" #f ("?.*")) --- module/ice-9/boot-9.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 0f89dcece..9f621d9df 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -538,7 +538,7 @@ If there is no handler at all, Guile prints an error and then exits." ((subr msg args . rest) (if subr (format port "In procedure ~a: " subr)) - (apply format port msg args)) + (apply format port msg (or args '()))) (_ (default-printer))) args)) From dcb7c7ddf5dc2c7e32720ed91c6d7bbed7f7455a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Feb 2011 23:26:08 +0100 Subject: [PATCH 050/183] flush all input on a read error * module/system/repl/repl.scm (flush-all-input): New helper. (prompting-meta-read): Flush all input on a read error, as we could be within some expression or a string or something. --- module/system/repl/repl.scm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 6eb29be91..0d7aca762 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -54,6 +54,13 @@ meta-command-token) (else (read port env)))))))) +(define (flush-all-input) + (if (and (char-ready?) + (not (eof-object? (peek-char)))) + (begin + (read-char) + (flush-all-input)))) + ;; repl-reader is a function defined in boot-9.scm, and is replaced by ;; something else if readline has been activated. much of this hoopla is ;; to be able to re-use the existing readline machinery. @@ -72,6 +79,7 @@ (else (format (current-output-port) "While reading expression:\n") (print-exception (current-output-port) #f key args) + (flush-all-input) *unspecified*))))) From 62cdb4e478d58ade852b04bdcfcf79c1ac815e21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 28 Feb 2011 00:21:48 +0100 Subject: [PATCH 051/183] Strip any CPPFLAGS other than `-I' from `guile-2.0.pc'. * configure.ac: Strip anything beyond `-I' from $GUILE_CFLAGS so that `guile-2.0.pc' does not export them to the user. Reported and fixed by Bruno Haible . --- configure.ac | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 423ae9988..992906401 100644 --- a/configure.ac +++ b/configure.ac @@ -1566,9 +1566,27 @@ AC_SUBST(LIBGUILE_I18N_INTERFACE) ####################################################################### -dnl Tell guile-config what flags guile users should compile and link with. +dnl Tell guile-config what flags guile users should compile and link +dnl with, keeping only `-I' flags from $CPPFLAGS. +GUILE_CFLAGS="" +next_is_includedir=false +for flag in $CPPFLAGS +do + if $next_is_includedir; then + GUILE_CFLAGS="$GUILE_CFLAGS -I $flag" + next_is_includedir=false + else + case "$flag" in + -I) next_is_includedir=true;; + -I*) GUILE_CFLAGS="$GUILE_CFLAGS $flag";; + *) ;; + esac + fi +done + +GUILE_CFLAGS="$GUILE_CFLAGS $PTHREAD_CFLAGS" GUILE_LIBS="$LDFLAGS $LIBS" -GUILE_CFLAGS="$CPPFLAGS $PTHREAD_CFLAGS" + AC_SUBST(GUILE_LIBS) AC_SUBST(GUILE_CFLAGS) From 6a94e6e1ae6c018fe1ea1c0c6a9cca577dff4d85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 28 Feb 2011 00:40:45 +0100 Subject: [PATCH 052/183] Link stand-alone tests against libgc. Reported by Andreas Rottmann . * test-suite/standalone/Makefile.am (LIBGUILE_LDADD): New variable. (test_num2integral_LDADD, test_round_LDADD, libtest_asmobs_la_LIBADD, libtest_ffi_la_LIBADD, test_list_LDADD, test_unwind_LDADD, test_conversion_LDADD, test_loose_ends_LDADD, test_scm_c_read_LDADD, test_scm_take_locale_symbol_LDADD, test_scm_take_u8vector_LDADD, libtest_extensions_la_LIBADD, test_with_guile_module_LDADD, test_scm_with_guile_LDADD): Use it. --- test-suite/standalone/Makefile.am | 34 ++++++++++++++++++------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 861e668b6..3e320675e 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -45,6 +45,12 @@ test_cflags = \ AM_LDFLAGS = $(GUILE_CFLAGS) +# How to link with libguile (same as `Libs' in `guile-2.0.pc'.) +LIBGUILE_LDADD = \ + ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la \ + $(BDW_GC_LIBS) + + snarfcppopts = \ -I$(top_srcdir) -I$(top_srcdir)/lib -I$(top_builddir)/lib -I$(top_builddir) \ -I. $(DEFS) $(DEFAULT_INCLUDES) $(CPPFLAGS) $(CFLAGS) @@ -69,13 +75,13 @@ TESTS += test-require-extension # test-num2integral test_num2integral_SOURCES = test-num2integral.c test_num2integral_CFLAGS = ${test_cflags} -test_num2integral_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_num2integral_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-num2integral TESTS += test-num2integral # test-round test_round_CFLAGS = ${test_cflags} -test_round_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_round_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-round TESTS += test-round @@ -86,7 +92,7 @@ noinst_LTLIBRARIES += libtest-asmobs.la libtest_asmobs_la_SOURCES = test-asmobs-lib.c libtest_asmobs_la_CFLAGS = ${test_cflags} libtest_asmobs_la_LDFLAGS = -module -no-undefined -rpath `pwd` # so libtool will really build an .so -libtest_asmobs_la_LIBADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +libtest_asmobs_la_LIBADD = $(LIBGUILE_LDADD) BUILT_SOURCES += test-asmobs-lib.x check_SCRIPTS += test-asmobs TESTS += test-asmobs @@ -96,7 +102,7 @@ noinst_LTLIBRARIES += libtest-ffi.la libtest_ffi_la_SOURCES = test-ffi-lib.c libtest_ffi_la_CFLAGS = ${test_cflags} libtest_ffi_la_LDFLAGS = -module -no-undefined -rpath `pwd` # so libtool will really build an .so -libtest_ffi_la_LIBADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +libtest_ffi_la_LIBADD = $(LIBGUILE_LDADD) check_SCRIPTS += test-ffi TESTS += test-ffi @@ -105,28 +111,28 @@ endif HAVE_SHARED_LIBRARIES # test-list test_list_SOURCES = test-list.c test_list_CFLAGS = ${test_cflags} -test_list_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_list_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-list TESTS += test-list # test-unwind test_unwind_SOURCES = test-unwind.c test_unwind_CFLAGS = ${test_cflags} -test_unwind_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_unwind_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-unwind TESTS += test-unwind # test-conversion test_conversion_SOURCES = test-conversion.c test_conversion_CFLAGS = ${test_cflags} -test_conversion_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_conversion_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-conversion TESTS += test-conversion # test-loose-ends test_loose_ends_SOURCES = test-loose-ends.c test_loose_ends_CFLAGS = ${test_cflags} -test_loose_ends_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_loose_ends_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-loose-ends TESTS += test-loose-ends @@ -141,21 +147,21 @@ TESTS += test-use-srfi # test-scm-c-read test_scm_c_read_SOURCES = test-scm-c-read.c test_scm_c_read_CFLAGS = ${test_cflags} -test_scm_c_read_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_scm_c_read_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-c-read TESTS += test-scm-c-read # test-scm-take-locale-symbol test_scm_take_locale_symbol_SOURCES = test-scm-take-locale-symbol.c test_scm_take_locale_symbol_CFLAGS = ${test_cflags} -test_scm_take_locale_symbol_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_scm_take_locale_symbol_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-take-locale-symbol TESTS += test-scm-take-locale-symbol # test-scm-take-u8vector test_scm_take_u8vector_SOURCES = test-scm-take-u8vector.c test_scm_take_u8vector_CFLAGS = ${test_cflags} -test_scm_take_u8vector_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_scm_take_u8vector_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-take-u8vector TESTS += test-scm-take-u8vector @@ -166,7 +172,7 @@ noinst_LTLIBRARIES += libtest-extensions.la libtest_extensions_la_SOURCES = test-extensions-lib.c libtest_extensions_la_CFLAGS = ${test_cflags} libtest_extensions_la_LDFLAGS = -module -no-undefined -rpath `pwd` # so libtool will really build an .so -libtest_extensions_la_LIBADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +libtest_extensions_la_LIBADD = $(LIBGUILE_LDADD) check_SCRIPTS += test-extensions TESTS += test-extensions @@ -176,12 +182,12 @@ if BUILD_PTHREAD_SUPPORT # test-with-guile-module test_with_guile_module_CFLAGS = ${test_cflags} -test_with_guile_module_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_with_guile_module_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-with-guile-module TESTS += test-with-guile-module test_scm_with_guile_CFLAGS = ${test_cflags} -test_scm_with_guile_LDADD = ${top_builddir}/libguile/libguile-@GUILE_EFFECTIVE_VERSION@.la +test_scm_with_guile_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-with-guile TESTS += test-scm-with-guile From ac012a27a2e3c28f191d2c38b3d1ab1ef70ba8ba Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 28 Feb 2011 20:53:40 +0100 Subject: [PATCH 053/183] update port-filename docs * doc/ref/api-io.texi (File Ports): * libguile/ports.c (scm_port_filename): Fix docs to match implementation. --- doc/ref/api-io.texi | 5 ++--- libguile/ports.c | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 52dfdd4fe..6a50424a4 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -949,9 +949,8 @@ used only during port creation are not retained. @deffn {Scheme Procedure} port-filename port @deffnx {C Function} scm_port_filename (port) -Return the filename associated with @var{port}. This function returns -the strings "standard input", "standard output" and "standard error" -when called on the current input, output and error ports respectively. +Return the filename associated with @var{port}, or @code{#f} if no +filename is associated with the port. @var{port} must be open, @code{port-filename} cannot be used once the port is closed. diff --git a/libguile/ports.c b/libguile/ports.c index 6a51ddc3c..a48cc8607 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1942,9 +1942,8 @@ SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0, SCM_DEFINE (scm_port_filename, "port-filename", 1, 0, 0, (SCM port), - "Return the filename associated with @var{port}. This function returns\n" - "the strings \"standard input\", \"standard output\" and \"standard error\"\n" - "when called on the current input, output and error ports respectively.") + "Return the filename associated with @var{port}, or @code{#f}\n" + "if no filename is associated with the port.") #define FUNC_NAME s_scm_port_filename { port = SCM_COERCE_OUTPORT (port); From 58b1db5f2437327e0d44cfe799ca8e21e27d5b5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 28 Feb 2011 23:33:47 +0100 Subject: [PATCH 054/183] Have `read' update line/column numbers when reading SCSH block comments. * libguile/read.c (scm_read_scsh_block_comment): Use `scm_getc' instead of `scm_get_byte_or_eof'. * test-suite/tests/reader.test ("read-options")["position of SCSH block comment"]: New test. --- libguile/read.c | 6 +----- test-suite/tests/reader.test | 11 +++++++++++ 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/libguile/read.c b/libguile/read.c index 5f0be3148..4057e4fd0 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1116,13 +1116,9 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port) { int bang_seen = 0; - /* We can use the get_byte here because there is no need to get the - locale correct when reading comments. This presumes that - hash and exclamation points always represent themselves no - matter what the source encoding is.*/ for (;;) { - int c = scm_get_byte_or_eof (port); + int c = scm_getc (port); if (c == EOF) scm_i_input_error ("skip_block_comment", port, diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 13c852665..1d6cc41ff 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -253,6 +253,14 @@ (read-string "'abcde"))))) (and (equal? (source-property sexp 'line) 0) (equal? (source-property sexp 'column) 0)))) + (pass-if "position of SCSH block comment" + ;; In Guile 2.0.0 the reader would not update the port's position + ;; when reading an SCSH block comment. + (let ((sexp (with-read-options '(positions) + (lambda () + (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n"))))) + (= 4 (source-property sexp 'line)))) + (with-test-prefix "r6rs-hex-escapes" (pass-if-exception "non-hex char in two-digit hex-escape" exception:illegal-escape @@ -417,3 +425,6 @@ ("#,@foo" . (unsyntax-splicing foo))))) +;;; Local Variables: +;;; eval: (put 'with-read-options 'scheme-indent-function 1) +;;; End: From bd79ebf3188ad0dc9f45290112f603f33af86f88 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 2 Mar 2011 06:02:58 -0500 Subject: [PATCH 055/183] Portability fixes for popen.test (for when /bin/sh is not bash) * test-suite/tests/popen.test (open-input-pipe no-duplicate): Pass "read REPLY" command instead of "read" to the subshell, for improved portability. In particular, it is needed when /bin/sh is dash. (open-output-pipe no-duplicate): Pass "exec guile [...]" instead of "guile [...]" to the subshell, to ensure that the subshell will not run guile as a subprocess while holding a duplicate of STDIN, which would cause this test to fail. This is needed when /bin/sh is dash. --- test-suite/tests/popen.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test index 6300c3b80..bfd7da71c 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -104,7 +104,7 @@ (with-input-from-port (car p2c) (lambda () (open-input-pipe - "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; read"))))))) + "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; read REPLY"))))))) (close-port (cdr c2p)) ;; write side (let ((result (eof-object? (read-char port)))) (display "hello!\n" (cdr p2c)) @@ -168,7 +168,7 @@ (port (with-error-to-port (cdr c2p) (lambda () (open-output-pipe - (string-append "guile --no-auto-compile -s \"" + (string-append "exec guile --no-auto-compile -s \"" (getenv "TEST_SUITE_DIR") "/tests/popen-child.scm\"")))))) (close-port (cdr c2p)) ;; write side From fba502dbccfa57c6a8f5b7bffa4fddfb22725677 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 2 Mar 2011 22:12:56 +0100 Subject: [PATCH 056/183] Improve the documentation for `dynamic-link'. * doc/ref/api-foreign.texi (Foreign Libraries): Make it clear that the LIBRARY argument of `dynamic-link' should not contain an extension. (Foreign Functions): Add cross-reference from `load-extension' to `dynamic-link'. Typeset file names and module names correctly. --- doc/ref/api-foreign.texi | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index e9d7df6eb..b91439e5a 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -79,6 +79,12 @@ Normally, @var{library} is just the name of some shared library file that will be searched for in the places where shared libraries usually reside, such as in @file{/usr/lib} and @file{/usr/local/lib}. +@var{library} should not contain an extension such as @code{.so}. The +correct file name extension for the host operating system is provided +automatically, according to libltdl's rules (@pxref{Libltdl interface, +lt_dlopenext, @code{lt_dlopenext}, libtool, Shared Library Support for +GNU}). + When @var{library} is omitted, a @dfn{global symbol handle} is returned. This handle provides access to the symbols available to the program at run-time, including those exported by the program itself and the shared libraries already @@ -196,12 +202,13 @@ In that case, you would statically link your program with the desired library, and register its init function right after Guile has been initialized. -LIB should be a string denoting a shared library without any file type -suffix such as ".so". The suffix is provided automatically. It +As for @code{dynamic-link}, @var{lib} should not contain any suffix such +as @code{.so} (@pxref{Foreign Libraries, dynamic-link}). It should also not contain any directory components. Libraries that implement Guile Extensions should be put into the normal locations for shared libraries. We recommend to use the naming convention -libguile-bla-blum for a extension related to a module `(bla blum)'. +@file{libguile-bla-blum} for a extension related to a module @code{(bla +blum)}. The normal way for a extension to be used is to write a small Scheme file that defines a module, and to load the extension into this From 9c3fa20a561e6693314fda9ad713ce70a80b88de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 3 Mar 2011 00:13:30 +0100 Subject: [PATCH 057/183] Remove extra comma after `SCM_ARRAY_ELEMENT_TYPE_LAST'. * libguile/array-handle.h (scm_t_array_element_type): Remove extra comma after last element. Reported by David Fang . Indent. --- libguile/array-handle.h | 42 +++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/libguile/array-handle.h b/libguile/array-handle.h index caf9cefbf..2e8af77b6 100644 --- a/libguile/array-handle.h +++ b/libguile/array-handle.h @@ -3,7 +3,8 @@ #ifndef SCM_ARRAY_HANDLE_H #define SCM_ARRAY_HANDLE_H -/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2004, 2006, + * 2008, 2009, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -64,25 +65,26 @@ typedef struct scm_t_array_dim ssize_t inc; } scm_t_array_dim; -typedef enum { - SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */ - SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */ - SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */ - SCM_ARRAY_ELEMENT_TYPE_VU8 = 3, - SCM_ARRAY_ELEMENT_TYPE_U8 = 4, - SCM_ARRAY_ELEMENT_TYPE_S8 = 5, - SCM_ARRAY_ELEMENT_TYPE_U16 = 6, - SCM_ARRAY_ELEMENT_TYPE_S16 = 7, - SCM_ARRAY_ELEMENT_TYPE_U32 = 8, - SCM_ARRAY_ELEMENT_TYPE_S32 = 9, - SCM_ARRAY_ELEMENT_TYPE_U64 = 10, - SCM_ARRAY_ELEMENT_TYPE_S64 = 11, - SCM_ARRAY_ELEMENT_TYPE_F32 = 12, - SCM_ARRAY_ELEMENT_TYPE_F64 = 13, - SCM_ARRAY_ELEMENT_TYPE_C32 = 14, - SCM_ARRAY_ELEMENT_TYPE_C64 = 15, - SCM_ARRAY_ELEMENT_TYPE_LAST = 15, -} scm_t_array_element_type; +typedef enum + { + SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */ + SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */ + SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */ + SCM_ARRAY_ELEMENT_TYPE_VU8 = 3, + SCM_ARRAY_ELEMENT_TYPE_U8 = 4, + SCM_ARRAY_ELEMENT_TYPE_S8 = 5, + SCM_ARRAY_ELEMENT_TYPE_U16 = 6, + SCM_ARRAY_ELEMENT_TYPE_S16 = 7, + SCM_ARRAY_ELEMENT_TYPE_U32 = 8, + SCM_ARRAY_ELEMENT_TYPE_S32 = 9, + SCM_ARRAY_ELEMENT_TYPE_U64 = 10, + SCM_ARRAY_ELEMENT_TYPE_S64 = 11, + SCM_ARRAY_ELEMENT_TYPE_F32 = 12, + SCM_ARRAY_ELEMENT_TYPE_F64 = 13, + SCM_ARRAY_ELEMENT_TYPE_C32 = 14, + SCM_ARRAY_ELEMENT_TYPE_C64 = 15, + SCM_ARRAY_ELEMENT_TYPE_LAST = 15 + } scm_t_array_element_type; SCM_INTERNAL SCM scm_i_array_element_types[]; From 51c0fd808683fdea689a91fb13b367fd98998c7a Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Thu, 3 Mar 2011 11:09:54 +0100 Subject: [PATCH 058/183] Use module identity to filter for existing modules This fixes a problem with R6RS's `import' in particuliar: when importing a subset of a library/module, the interface created for that purpose inherits the name of the module it is derived from. The low-level primitives that are used for importing would then disregard earlier imports from the same module. An example for this bug can be seen with the following library definition: (library (test-guile2) (export foo) (import (only (rnrs base) define) (only (rnrs base) error)) (define (foo . args) #t)) In the above, the import of `define' would be disregarded when `error' is imported, thus leading to a syntax error, since `(foo . args)' is treated as an application, since the binding of `define' would be not present. * module/ice-9/boot-9.scm (module-use!): Remove the filtering of the existing imports of the module by name; a check for identity is already done beforehand. (module-use-interfaces!): Filter the existing imports by identity instead of filtering them by their names. --- module/ice-9/boot-9.scm | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 9f621d9df..fbad99b8c 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1987,13 +1987,8 @@ VALUE." ;; Newly used modules must be appended rather than consed, so that ;; `module-variable' traverses the use list starting from the first ;; used module. - (set-module-uses! module - (append (filter (lambda (m) - (not - (equal? (module-name m) - (module-name interface)))) - (module-uses module)) - (list interface))) + (set-module-uses! module (append (module-uses module) + (list interface))) (hash-clear! (module-import-obarray module)) (module-modified module)))) @@ -2004,8 +1999,7 @@ VALUE." (define (module-use-interfaces! module interfaces) (let ((prev (filter (lambda (used) (and-map (lambda (iface) - (not (equal? (module-name used) - (module-name iface)))) + (not (eq? used iface))) interfaces)) (module-uses module)))) (set-module-uses! module From 8d795c83d463e893cdac16733fd42bef809c0d79 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 3 Mar 2011 11:29:27 +0100 Subject: [PATCH 059/183] more module-use-interfaces! tweaks * module/ice-9/boot-9.scm (module-use-interfaces!): Fix up to prevent duplication in the use list of multiple incoming interfaces. * test-suite/tests/modules.test ("module-use"): Add tests. --- module/ice-9/boot-9.scm | 20 +++++++++------- test-suite/tests/modules.test | 45 +++++++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 8 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index fbad99b8c..7ca08062f 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1994,16 +1994,20 @@ VALUE." ;; MODULE-USE-INTERFACES! module interfaces ;; -;; Same as MODULE-USE! but add multiple interfaces and check for duplicates +;; Same as MODULE-USE!, but only notifies module observers after all +;; interfaces are added to the inports list. ;; (define (module-use-interfaces! module interfaces) - (let ((prev (filter (lambda (used) - (and-map (lambda (iface) - (not (eq? used iface))) - interfaces)) - (module-uses module)))) - (set-module-uses! module - (append prev interfaces)) + (let* ((cur (module-uses module)) + (new (let lp ((in interfaces) (out '())) + (if (null? in) + (reverse out) + (lp (cdr in) + (let ((iface (car in))) + (if (or (memq iface cur) (memq iface out)) + out + (cons iface out)))))))) + (set-module-uses! module (append cur new)) (hash-clear! (module-import-obarray module)) (module-modified module))) diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test index 29abd093a..5f34d9e70 100644 --- a/test-suite/tests/modules.test +++ b/test-suite/tests/modules.test @@ -144,6 +144,51 @@ (eq? (module-public-interface the-scm-module) the-scm-module))) + +;;; +;;; module-use! / module-use-interfaces! +;;; +(with-test-prefix "module-use" + (let ((m (make-module))) + (pass-if "no uses initially" + (null? (module-uses m))) + + (pass-if "using ice-9 q" + (begin + (module-use! m (resolve-interface '(ice-9 q))) + (equal? (module-uses m) + (list (resolve-interface '(ice-9 q)))))) + + (pass-if "using ice-9 q again" + (begin + (module-use! m (resolve-interface '(ice-9 q))) + (equal? (module-uses m) + (list (resolve-interface '(ice-9 q)))))) + + (pass-if "using ice-9 ftw" + (begin + (module-use-interfaces! m (list (resolve-interface '(ice-9 ftw)))) + (equal? (module-uses m) + (list (resolve-interface '(ice-9 q)) + (resolve-interface '(ice-9 ftw)))))) + + (pass-if "using ice-9 ftw again" + (begin + (module-use-interfaces! m (list (resolve-interface '(ice-9 ftw)))) + (equal? (module-uses m) + (list (resolve-interface '(ice-9 q)) + (resolve-interface '(ice-9 ftw)))))) + + (pass-if "using ice-9 control twice" + (begin + (module-use-interfaces! m (list (resolve-interface '(ice-9 control)) + (resolve-interface '(ice-9 control)))) + (equal? (module-uses m) + (list (resolve-interface '(ice-9 q)) + (resolve-interface '(ice-9 ftw)) + (resolve-interface '(ice-9 control)))))))) + + ;;; ;;; Resolve-module. From d900843c72ee1f34d79527deb38787e581592cf5 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 3 Mar 2011 12:46:49 +0100 Subject: [PATCH 060/183] fix encoding scanning for non-seekable ports * libguile/read.c (scm_i_scan_for_encoding): If possible, just use the read buffer for the encoding scan, and avoid seeking. Fixes `(open-input-file "/dev/urandom")', because /dev/urandom can't be seeked backwards. --- libguile/read.c | 48 +++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 41 insertions(+), 7 deletions(-) diff --git a/libguile/read.c b/libguile/read.c index 4057e4fd0..a889133a7 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1650,6 +1650,7 @@ scm_get_hash_procedure (int c) char * scm_i_scan_for_encoding (SCM port) { + scm_t_port *pt; char header[SCM_ENCODING_SEARCH_SIZE+1]; size_t bytes_read, encoding_length, i; char *encoding = NULL; @@ -1657,15 +1658,46 @@ scm_i_scan_for_encoding (SCM port) char *pos, *encoding_start; int in_comment; - if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port))) - /* PORT is a non-seekable file port (e.g., as created by Bash when using - "guile <(echo '(display "hello")')") so bail out. */ - return NULL; + pt = SCM_PTAB_ENTRY (port); - bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE); - header[bytes_read] = '\0'; + if (pt->rw_active == SCM_PORT_WRITE) + scm_flush (port); - scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET)); + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; + + if (pt->read_pos == pt->read_end) + { + /* We can use the read buffer, and thus avoid a seek. */ + if (scm_fill_input (port) == EOF) + return NULL; + + bytes_read = pt->read_end - pt->read_pos; + if (bytes_read > SCM_ENCODING_SEARCH_SIZE) + bytes_read = SCM_ENCODING_SEARCH_SIZE; + + if (bytes_read <= 1) + /* An unbuffered port -- don't scan. */ + return NULL; + + memcpy (header, pt->read_pos, bytes_read); + header[bytes_read] = '\0'; + } + else + { + /* Try to read some bytes and then seek back. Not all ports + support seeking back; and indeed some file ports (like + /dev/urandom) will succeed on an lseek (fd, 0, SEEK_CUR)---the + check performed by SCM_FPORT_FDES---but fail to seek + backwards. Hence this block comes second. We prefer to use + the read buffer in-place. */ + if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port))) + return NULL; + + bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE); + header[bytes_read] = '\0'; + scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET)); + } if (bytes_read > 3 && header[0] == '\xef' && header[1] == '\xbb' && header[2] == '\xbf') @@ -1757,6 +1789,8 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0, char *enc; SCM s_enc; + SCM_VALIDATE_OPINPORT (SCM_ARG1, port); + enc = scm_i_scan_for_encoding (port); if (enc == NULL) return SCM_BOOL_F; From 859e58ae8a77c0c725a5027d1bb3809e9772076e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 3 Mar 2011 23:19:35 +0100 Subject: [PATCH 061/183] repl.scm refactor * module/system/repl/repl.scm (flush-leading-whitespace): Rename from next-char. (meta-reader): Use flush-leading-whitespace. (run-repl): Use flush-to-newline after the evaluation, which seems to be the same as what we did before. --- module/system/repl/repl.scm | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 0d7aca762..4ad7aec84 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -43,7 +43,7 @@ (lambda* (#:optional (port (current-input-port))) (with-input-from-port port (lambda () - (let ((ch (next-char #t))) + (let ((ch (flush-leading-whitespace))) (cond ((eof-object? ch) ;; EOF objects are not buffered. It's quite possible ;; to peek an EOF then read something else. It's @@ -157,18 +157,17 @@ (lambda (k . args) (abort args)))) #:trap-handler 'disabled))) - (next-char #f) ;; consume trailing whitespace + (flush-to-newline) ;; consume trailing whitespace (prompt-loop)))) (lambda (k status) status))) -(define (next-char wait) - (if (or wait (char-ready?)) - (let ((ch (peek-char))) - (cond ((eof-object? ch) ch) - ((char-whitespace? ch) (read-char) (next-char wait)) - (else ch))) - #f)) +;; Returns first non-whitespace char. +(define (flush-leading-whitespace) + (let ((ch (peek-char))) + (cond ((eof-object? ch) ch) + ((char-whitespace? ch) (read-char) (flush-leading-whitespace)) + (else ch)))) (define (flush-to-newline) (if (char-ready?) From 65fa60ca7a7bbfd712371f7b2471efe7b056839c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 3 Mar 2011 23:51:20 +0100 Subject: [PATCH 062/183] repl.scm understands comments * module/system/repl/repl.scm (read-comment, read-scheme-line-comment) (read-scheme-datum-comment): New helpers. (meta-reader): Take a language instead of a reader. If we have a nonwhitespace char, first check to see that it's a comment, and if so, read it off and loop. (prompting-meta-read): Call meta-reader with the lang. --- module/system/repl/repl.scm | 53 +++++++++++++++++++++++++++++++++---- 1 file changed, 48 insertions(+), 5 deletions(-) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 4ad7aec84..39f2319bf 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -31,6 +31,48 @@ #:use-module (ice-9 control) #:export (start-repl run-repl)) + +;;; +;;; Comments +;;; +;;; (You don't want a comment to force a continuation line.) +;;; + +(define (read-scheme-line-comment port) + (let lp () + (let ((ch (read-char port))) + (or (eof-object? ch) + (eqv? ch #\newline) + (lp))))) + +(define (read-scheme-datum-comment port) + (read port)) + +;; ch is a peeked char +(define (read-comment lang port ch) + (and (eq? (language-name lang) 'scheme) + (case ch + ((#\;) + (read-char port) + (read-scheme-line-comment port) + #t) + ((#\#) + (read-char port) + (case (peek-char port) + ((#\;) + (read-char port) + (read-scheme-datum-comment port) + #t) + ;; Not doing R6RS block comments because of the possibility + ;; of read-hash extensions. Lame excuse. Not doing scsh + ;; block comments either, because I don't feel like handling + ;; #!r6rs. + (else + (unread-char #\# port) + #f))) + (else + #f)))) + ;;; @@ -39,7 +81,7 @@ (define meta-command-token (cons 'meta 'command)) -(define (meta-reader read env) +(define (meta-reader lang env) (lambda* (#:optional (port (current-input-port))) (with-input-from-port port (lambda () @@ -52,7 +94,9 @@ ((eqv? ch #\,) (read-char port) meta-command-token) - (else (read port env)))))))) + ((read-comment lang port ch) + *unspecified*) + (else ((language-reader lang) port env)))))))) (define (flush-all-input) (if (and (char-ready?) @@ -70,8 +114,7 @@ (catch #t (lambda () (repl-reader (lambda () (repl-prompt repl)) - (meta-reader (language-reader (repl-language repl)) - (current-module)))) + (meta-reader (repl-language repl) (current-module)))) (lambda (key . args) (case key ((quit) @@ -116,7 +159,7 @@ (let prompt-loop () (let ((exp (prompting-meta-read repl))) (cond - ((eqv? exp *unspecified*)) ; read error, pass + ((eqv? exp *unspecified*)) ; read error or comment, pass ((eq? exp meta-command-token) (catch #t (lambda () From c7d6f8b27949e12b6e358e4c9580affddb339af6 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 4 Mar 2011 10:33:51 +0100 Subject: [PATCH 063/183] fix ,stat * module/system/repl/command.scm (statistics): Fix for BDW-GC. Unfortunately we still don't have mallocation or time taken. --- module/system/repl/command.scm | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index d4b3e4a77..58ce12e62 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -1,6 +1,6 @@ ;;; Repl commands -;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -858,30 +858,21 @@ Display statistics." (display-diff-stat "GC times:" #t this-times last-times "times") (newline)) ;; Memory size - (let ((this-cells (assq-ref this-gcs 'cells-allocated)) - (this-heap (assq-ref this-gcs 'cell-heap-size)) - (this-bytes (assq-ref this-gcs 'bytes-malloced)) - (this-malloc (assq-ref this-gcs 'gc-malloc-threshold))) + (let ((this-heap (assq-ref this-gcs 'heap-size)) + (this-free (assq-ref this-gcs 'heap-free-size))) (display-stat-title "Memory size:" "current" "limit") - (display-stat "heap" #f this-cells this-heap "cells") - (display-stat "malloc" #f this-bytes this-malloc "bytes") + (display-stat "heap" #f (- this-heap this-free) this-heap "bytes") (newline)) ;; Cells collected - (let ((this-marked (assq-ref this-gcs 'cells-marked)) - (last-marked (assq-ref last-gcs 'cells-marked)) - (this-swept (assq-ref this-gcs 'cells-swept)) - (last-swept (assq-ref last-gcs 'cells-swept))) - (display-stat-title "Cells collected:" "diff" "total") - (display-diff-stat "marked" #f this-marked last-marked "cells") - (display-diff-stat "swept" #f this-swept last-swept "cells") + (let ((this-alloc (assq-ref this-gcs 'heap-total-allocated)) + (last-alloc (assq-ref last-gcs 'heap-total-allocated))) + (display-stat-title "Bytes allocated:" "diff" "total") + (display-diff-stat "allocated" #f this-alloc last-alloc "bytes") (newline)) ;; GC time taken - (let ((this-mark (assq-ref this-gcs 'gc-mark-time-taken)) - (last-mark (assq-ref last-gcs 'gc-mark-time-taken)) - (this-total (assq-ref this-gcs 'gc-time-taken)) + (let ((this-total (assq-ref this-gcs 'gc-time-taken)) (last-total (assq-ref last-gcs 'gc-time-taken))) (display-stat-title "GC time taken:" "diff" "total") - (display-time-stat "mark" this-mark last-mark) (display-time-stat "total" this-total last-total) (newline)) ;; Process time spent From 47b86dbf4dc3da2f4d6d41a018cd221fbf0823ee Mon Sep 17 00:00:00 2001 From: Michael Gran Date: Sun, 20 Feb 2011 21:53:46 -0800 Subject: [PATCH 064/183] Add ,width meta-command to set screen width in debug output This meta-command allows one to set the default number of columns that output from ,backtrace and ,locals shall occupy. * doc/ref/scheme-using.texi (Debug Commands): document ,width * module/system/repl/command.scm (*width*): new var (backtrace, locals): use *width* in optarg (width): new meta-command --- doc/ref/scheme-using.texi | 6 ++++++ module/system/repl/command.scm | 21 ++++++++++++++++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index 126b84590..a119d4218 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -337,6 +337,12 @@ Show the VM registers associated with the current frame. @xref{Stack Layout}, for more information on VM stack frames. @end deffn +@deffn {REPL Command} width [cols] +Sets the number of display columns in the output of @code{,backtrace} +and @code{,locals} to @var{cols}. If @var{cols} is not given, the width +of the terminal is used. +@end deffn + The next 3 commands work at any REPL. @deffn {REPL Command} break proc diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 58ce12e62..2ae266f7b 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -71,6 +71,8 @@ (define *show-table* '((show (warranty w) (copying c) (version v)))) +(define *width* 72) + (define (group-name g) (car g)) (define (group-commands g) (cdr g)) @@ -546,7 +548,7 @@ Trace execution." (format #t "Nothing to debug.~%")))))))) (define-stack-command (backtrace repl #:optional count - #:key (width 72) full?) + #:key (width *width*) full?) "backtrace [COUNT] [#:width W] [#:full? F] Print a backtrace. @@ -626,12 +628,12 @@ With an argument, select a frame by index, then show it." Print the procedure for the selected frame." (repl-print repl (frame-procedure cur))) -(define-stack-command (locals repl) +(define-stack-command (locals repl #:key (width *width*)) "locals Show local variables. Show locally-bound variables in the selected frame." - (print-locals cur)) + (print-locals cur #:width width)) (define-stack-command (error-message repl) "error-message @@ -811,6 +813,19 @@ Print registers. Print the registers of the current frame." (print-registers cur)) +(define-meta-command (width repl #:optional x) + "width [X] +Set debug output width. + +Set the number of screen columns in the output from `backtrace' and +`locals'." + (if (and x (not (integer? x))) + (error "expected a column number (a non-negative integer)" x) + (let ((w (or x + (false-if-exception (string->number (getenv "COLUMNS"))) + 72))) + (format #t "Setting screen width to ~a columns~%" w) + (set! *width* w)))) ;;; From 090f14b890ec31844bca6b93256a39d3bd80aba3 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 4 Mar 2011 11:16:15 +0100 Subject: [PATCH 065/183] repl: terminal-width by default * module/system/repl/command.scm (terminal-width): New parameter that will use the true terminal width if unset. (backtrace, locals): Default to (terminal-width). (width): Simplify. --- module/system/repl/command.scm | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 2ae266f7b..685eebb0b 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -71,7 +71,19 @@ (define *show-table* '((show (warranty w) (copying c) (version v)))) -(define *width* 72) +(define terminal-width + (let ((set-width #f)) + (case-lambda + (() + (or set-width + (let ((w (false-if-exception (string->number (getenv "COLUMNS"))))) + (and (integer? w) (exact? w) (> w 0) w)) + 72)) + ((w) + (if (or (not w) (and (integer? w) (exact? w) (> w 0))) + (set! set-width w) + (error "Expected a column number (a positive integer)" w)))))) + (define (group-name g) (car g)) (define (group-commands g) (cdr g)) @@ -548,7 +560,7 @@ Trace execution." (format #t "Nothing to debug.~%")))))))) (define-stack-command (backtrace repl #:optional count - #:key (width *width*) full?) + #:key (width (terminal-width)) full?) "backtrace [COUNT] [#:width W] [#:full? F] Print a backtrace. @@ -628,7 +640,7 @@ With an argument, select a frame by index, then show it." Print the procedure for the selected frame." (repl-print repl (frame-procedure cur))) -(define-stack-command (locals repl #:key (width *width*)) +(define-stack-command (locals repl #:key (width (terminal-width))) "locals Show local variables. @@ -819,13 +831,9 @@ Set debug output width. Set the number of screen columns in the output from `backtrace' and `locals'." - (if (and x (not (integer? x))) - (error "expected a column number (a non-negative integer)" x) - (let ((w (or x - (false-if-exception (string->number (getenv "COLUMNS"))) - 72))) - (format #t "Setting screen width to ~a columns~%" w) - (set! *width* w)))) + (terminal-width x) + (format #t "Set screen width to ~a columns.~%" (terminal-width))) + ;;; From 2dea6a4d33561e1403b1c330f2b8ed3d87f0d1c6 Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Tue, 22 Feb 2011 15:15:33 -0500 Subject: [PATCH 066/183] add guile-snarf tests * test-suite/standalone/test-guile-snarf: New file. * test-suite/standalone/Makefile.am: Add `test-guile-snarf'. --- test-suite/standalone/Makefile.am | 3 +++ test-suite/standalone/test-guile-snarf | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100755 test-suite/standalone/test-guile-snarf diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 3e320675e..d839e2389 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -72,6 +72,9 @@ TESTS += test-bad-identifiers check_SCRIPTS += test-require-extension TESTS += test-require-extension +check_SCRIPTS += test-guile-snarf +TESTS += test-guile-snarf + # test-num2integral test_num2integral_SOURCES = test-num2integral.c test_num2integral_CFLAGS = ${test_cflags} diff --git a/test-suite/standalone/test-guile-snarf b/test-suite/standalone/test-guile-snarf new file mode 100755 index 000000000..94cfd9023 --- /dev/null +++ b/test-suite/standalone/test-guile-snarf @@ -0,0 +1,20 @@ +#!/bin/sh +snarf () +{ + echo "$1" | guile-snarf - | tail -n +2 | tr -d ' \t\n' +} + +snarf_test () +{ + x=`snarf "$1"` + if [ x"$x" != x"$2" ]; then + echo "Incorrect output: expected \"$2\", but got \"$x\"" + exit 1 + fi +} + +snarf_test "^^a^:^" "a;" +snarf_test " ^ ^ b ^ : ^ " "b;" +#snarf_test "c\n^^d^:^\ne" "d;" +#snarf_test "f^^g^:^h" "g;" +#snarf_test "^^i^:^j^^k^:^" "i;k;" From fd029c35de681efe530ba1e054e918c69d3602ef Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Tue, 22 Feb 2011 13:15:31 -0500 Subject: [PATCH 067/183] guile-snarf: allow multiple init actions on one line * libguile/guile-snarf.in (modern_snarf): Allow programs to specify multiple initialization actions on a single line. This makes it possible for C programs to define multiple subrs with a single macro invocation. * test-suite/standalone/test-guile-snarf: Enable more tests. --- libguile/guile-snarf.in | 2 +- test-suite/standalone/test-guile-snarf | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index 043b3ed0d..a1aeba577 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -51,7 +51,7 @@ modern_snarf () # writes stdout ## empty file. echo "/* cpp arguments: $@ */" ; ${cpp} -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp} && cpp_ok_p=true - grep "^ *\^ *\^" ${temp} | sed -e "s/ *\^ *\^//g" -e "s/\^ *: *\^/;/g" + sed -ne "s/ *\^ *: *\^/\n/;s/[^\n]*\^ *\^ *\([^\n]*\)/\1;/;tx;d;:x;P;D" ${temp} } ## main diff --git a/test-suite/standalone/test-guile-snarf b/test-suite/standalone/test-guile-snarf index 94cfd9023..78d35ea16 100755 --- a/test-suite/standalone/test-guile-snarf +++ b/test-suite/standalone/test-guile-snarf @@ -15,6 +15,6 @@ snarf_test () snarf_test "^^a^:^" "a;" snarf_test " ^ ^ b ^ : ^ " "b;" -#snarf_test "c\n^^d^:^\ne" "d;" -#snarf_test "f^^g^:^h" "g;" -#snarf_test "^^i^:^j^^k^:^" "i;k;" +snarf_test "c\n^^d^:^\ne" "d;" +snarf_test "f^^g^:^h" "g;" +snarf_test "^^i^:^j^^k^:^" "i;k;" From 900a6f87bad5c5a34f017cc6c851483758433f38 Mon Sep 17 00:00:00 2001 From: Mark Harig Date: Fri, 4 Mar 2011 19:36:28 -0500 Subject: [PATCH 068/183] Updated Guile manual page. * doc/guile.1: Added the current month and year, Guile version descriptive text, and the text GNU to the title. Updated the nroff formatting commands for the SYNOPSIS and OPTIONS sections to what 'man' prescribes. See 'man(1)', 'man(7)', and 'man-pages(7)'. Corrected grammar, spelling, and capitalization (for example, 'scheme' to 'Scheme'). Vertical white-space was non-standard (two lines between some sections, one space between others). Changed this to the standard one empty line before each section heading, and added dots (a single period on a line) before every section heading (.SH) so that maintainers will find the readability unchanged. Added white space to follow the 'groff' recommendation of starting every sentence on its own line, and breaking sentences at punctuation. Corrected an error in description of the info command. Added the missing option '--no-debug', and the short switches '-h' and '-v'. Changed the description of the environment variable GUILE_LOAD_COMPILED_PATH so that it references the Guile variable `%load-compiled-path' instead of the variable `%load-path'. Updated the copyright to include 2011. --- doc/guile.1 | 295 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 199 insertions(+), 96 deletions(-) diff --git a/doc/guile.1 b/doc/guile.1 index 2d1fba956..e36c2aac7 100644 --- a/doc/guile.1 +++ b/doc/guile.1 @@ -3,113 +3,210 @@ .\" Process this file with .\" groff -man -Tascii foo.1 .\" -.TH GUILE 1 +.\" title section date source manual +.TH GUILE 1 "2011-03-04" GNU "GNU Guile 2.0" +. .SH NAME -guile \- the GNU extension language +guile \- The GNU Project Extension Language +. .SH SYNOPSIS -.B guile [-L DIRECTORY] [-l FILE] [-e FUNCTION] [\\\\] -.B [-c EXPR] [-s SCRIPT] [--] [SCRIPT] [ARG...] +.B guile +.RB [\| \-L +.IR DIRECTORY \|] +.RB [\| \-l +.IR FILE \|] +.RB [\| \-e +.IR FUNCTION \|] +.\".RI [\| \\\\ \|] +.RB [\| \e \|] +.RB [\| \-c +.IR EXPR \|] +.RB [\| \-s +.IR SCRIPT \|] +.RB [\| \-\- \|] +.RI [\| SCRIPT +.RI [\| ARGs\ for\ SCRIPT \|]\c +.RI ] -Only the most useful options are listed here; see below for the -remainder. +Only the most useful options are listed here; +see below for the remainder. +. .SH DESCRIPTION -GNU Guile is an implemention of the Scheme programming language. It -extends the R5RS and R6RS language standards, providing additional -features necessary for real-world use. Guile works well for interactive -use, basic scripting, and extension of larger applications, as well as -for stand-alone Scheme application development. +GNU Guile is an implementation of the Scheme programming language. +It extends the R5RS and R6RS language standards, +providing additional features necessary for real-world use. + +Guile works well for interactive use, +basic scripting, +and extension of larger applications, +as well as for stand-alone Scheme application development. The .B guile executable itself provides a stand-alone interactive compiler and -run-time for Scheme programs, both for interactive use and for executing -Scheme scripts or programs. +run-time for Scheme programs, +both for interactive use and for executing Scheme scripts or programs. This manual page provides only brief instruction in invoking .B guile -from the command line. Please consult the guile info documentation -(type -.B info "guile(Invoking Guile)" -at a command prompt) for more information. - +from the command line. +Please consult the Guile info documentation for more information, +(type \fB info "(guile)Invoking Guile"\fR at a command prompt). +. .SH OPTIONS -.IP -L DIRECTORY -Add DIRECTORY to the front of Guile's module load path. -.IP -l FILE -Load scheme source code from file. -.IP -e FUNCTION -After reading script, apply FUNCTION to command-line arguments. Note -that FUNCTION is evaluated, so e.g. +.TP +.BI -L \ DIRECTORY +Add \fIDIRECTORY\fR to the front of Guile's module load path. +. +.TP +.BI -l \ FILE +Load Scheme source code from \fIFILE\fR. +. +.TP +.BI -e \ FUNCTION +After reading \fISCRIPT\fR, apply \fIFUNCTION\fR to command-line arguments. +Note that \fIFUNCTION\fR is evaluated, +so, for example, .B (@ (my-module) my-proc) is valid here. -.IP \\\\ +. +.TP +.B \e The "meta switch", used to work around limitations in #! scripts. -See "The Meta Switch" in the texinfo documentation, for more details. -.IP -- -Stop argument processing, start guile in interactive mode. -.IP -c EXPR -Stop argument processing, evaluate EXPR as a scheme expression. -.IP -s SCRIPT-FILE -Load Scheme source from SCRIPT-FILE and execute as a script. Note that -the in many cases it is not necessary to use -s; one may invoke Guile -just as -.B guile SCRIPT-FILE ARG... -.IP -ds -Do -s SCRIPT at this point. Note that this argument must be used in -conjuction with -s. -.IP --debug -Start guile with the debugging VM. By default, on when invoked -interactively, off otherwise. -.IP --auto-compile +See "The Meta Switch" in the texinfo documentation for more details. +. +.TP +.B -- +Stop argument processing, and start +.B guile +in interactive mode. +. +.TP +.BI -c \ EXPR +Stop argument processing, +and evaluate \fIEXPR\fR as a Scheme expression. +. +.TP +.BI -s \ SCRIPT-FILE +Load Scheme source from \fISCRIPT-FILE\fR and execute as a script. +Note that in many cases it is not necessary to use \fB-s\fR; +one may invoke +.B guile +simply as +.B guile +.I SCRIPT-FILE ARG... +. +.TP +.B -ds +Carry out \fB\-s \fISCRIPT\fR at this point in the option sequence. +Note that this argument must be used in conjunction with \fB\-s\fR. +. +.TP +.B --debug +Start +.B guile +with the debugging VM. +By default, debugging is on when +.B guile +is invoked interactively; +it is off otherwise. +. +.TP +.B --no-debug +Start +.B guile +without the debugging VM, +even if +.B guile +is being run interactively. +. +.TP +.B --auto-compile Compile source files automatically (default behavior). -.IP --no-auto-compile +. +.TP +.B --no-autocompile Disable automatic source file compilation. -.IP --listen[=P] -Listen on a port or socket for remote REPL connections. See the manual -for more details. -.IP --use-srfi=N,M... -Load SRFI extensions N, M, etc. For example, "--use-srfi=8,13". -.IP -x EXTENSION -Add EXTENSION to the Guile's load extension list. -.IP --help -Describe command line options and exit -.IP --version +. +.TP +\fB\-\-listen\fR[=\fIP\fR] +Listen on a port or socket for remote REPL connections. +See the manual for more details. +. +.TP +\fB\-\-use\-srfi\fR=\fIN,M\fR... +Load SRFI extensions \fIN\fR, \fIM\fR, etc. +For example, +\fB \-\-use\-srfi\fR=\fI8,13\fR. +. +.TP +.BI -x \ EXTENSION +Add \fIEXTENSION\fR to the +.B guile +load extension list. +. +.TP +\fB\-h\fR, \fB\-\-help\fR +Describe command-line options and exit. +. +.TP +\fB\-v\fR, \fB\-\-version\fR Display guile version and exit. -.IP -q -In interactive mode, suppress loading the user's ~/.guile file. - +. +.TP +.B -q +In interactive mode, +suppress loading the user's initialization file, +.I ~/.guile. +. .SH ENVIRONMENT .\".TP \w'MANROFFSEQ\ \ 'u .TP .B GUILE_LOAD_PATH If .RB $ GUILE_LOAD_PATH -is set, its value is used to agument the path to search for scheme -files when loading. It should be a colon separated list of -directories which will be prepended to the default %load-path. - +is set before +.B guile +is started, +its value is used to augment the path to search for Scheme files when +loading. +It should be a colon-separated list of directories, +which will be prefixed to the default +.B %load-path. +.TP .B GUILE_LOAD_COMPILED_PATH If .RB $ GUILE_LOAD_COMPILED_PATH -is set, its value is used to agument the path to search for compiled -Scheme files (.go files) when loading. It should be a colon separated -list of directories which will be prepended to the default %load-path. - +is set before +.B guile +is started, +its value is used to augment the path to search for compiled +Scheme files (.go files) when loading. +It should be a colon-separated list of directories, +which will be prefixed to the default +.B %load-compiled-path. +. .SH FILES +.TP .I ~/.guile -is a guile script that is executed before any other processing occurs. -For example, the following .guile activates guile's readline -interface: +A Guile script that is executed before any other processing occurs. +For example, the following +.I .guile +activates guile's readline interface: -.RS 4 -(use-modules (ice-9 readline)) +.RS 9 +.B (use-modules (ice-9 readline)) .RS 0 -(activate-readline) - +.B (activate-readline) +. .SH "SEE ALSO" -The full documentation for guile is maintained as a Texinfo manual. If -the info and guile programs are properly installed at your site, the -command +The full documentation for Guile is maintained as a Texinfo manual. +If the +.B info +and +.B guile +programs are properly installed at your site, +the command .IP .B info guile .PP @@ -117,39 +214,45 @@ should give you access to the complete manual. http://www.schemers.org provides a general introduction to the Scheme language. - +. .SH "REPORTING BUGS" -There is a mailing list, bug-guile@gnu.org, for reporting Guile bugs and -fixes. But before reporting something as a bug, please try to be sure -that it really is a bug, not a misunderstanding or a deliberate feature. +There is a mailing list, +bug-guile@gnu.org, +for reporting Guile bugs and fixes. +But before reporting something as a bug, +please try to be sure that it really is a bug, +not a misunderstanding or a deliberate feature. We ask you to read the section ``Reporting Bugs'' in the Guile reference -manual (or Info system) for hints on how and when to report bugs. Also, -include the version number of the Guile you are running in every bug -report that you send in. Bugs tend actually to be fixed if they can be -isolated, so it is in your interest to report them in such a way that -they can be easily reproduced. - +manual (or Info system) for hints on how and when to report bugs. +Also, include the version number of the Guile you are running in every bug +report that you send in. +Bugs tend actually to get fixed if they can be isolated, +so it is in your interest to report them in such a way that they can be +easily reproduced. +. .SH COPYING -Copyright (C) 2010 Free Software Foundation, Inc. +Copyright (C) 2010, 2011 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are preserved on all copies. Permission is granted to copy and distribute modified versions of this -document under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. +document under the conditions for verbatim copying, +provided that the entire resulting derived work is distributed under the +terms of a permission notice identical to this one. Permission is granted to copy and distribute translations of this -document into another language, under the above conditions for modified -versions, except that this permission notice may be stated in a +document into another language, +under the above conditions for modified versions, +except that this permission notice may be stated in a translation approved by the Free Software Foundation. - +. .SH AUTHORS -Robert Merkel wrote this manpage. +Robert Merkel wrote this manpage. Rob Browning has added to it. -.B guile -is GNU software. Guile is originally based on Aubrey Jaffer's -SCM interpreter, and is the work of many individuals. +.B guile +is GNU software. +Guile is originally based on Aubrey Jaffer's SCM interpreter, +and is the work of many individuals. From b6b84131cd2cf36b49e65f30a67dbc114b78c610 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 5 Mar 2011 21:48:47 +0100 Subject: [PATCH 069/183] remove obsolete comments * libguile/eval.c (scm_nconc2last): * libguile/strports.c (scm_c_read_string): Remove some obsolete comments. --- libguile/eval.c | 6 +----- libguile/strports.c | 1 - 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/libguile/eval.c b/libguile/eval.c index 6f2020ebc..b52cc2788 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -543,11 +543,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0, SCM *lloc; SCM_VALIDATE_NONEMPTYLIST (1, lst); lloc = &lst; - while (!scm_is_null (SCM_CDR (*lloc))) /* Perhaps should be - SCM_NULL_OR_NIL_P, but not - needed in 99.99% of cases, - and it could seriously hurt - performance. - Neil */ + while (!scm_is_null (SCM_CDR (*lloc))) lloc = SCM_CDRLOC (*lloc); SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME); *lloc = SCM_CAR (*lloc); diff --git a/libguile/strports.c b/libguile/strports.c index 64987fabc..af601cf6e 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -475,7 +475,6 @@ scm_c_read_string (const char *expr) "scm_c_read_string"); SCM form; - /* Read expressions from that port; ignore the values. */ form = scm_read (port); scm_close_port (port); From d59dd06eb9a3a45b9a385421555b2414345d7272 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 5 Mar 2011 23:16:11 +0100 Subject: [PATCH 070/183] add ice-9 eval-string * module/Makefile.am: * module/ice-9/eval-string.scm: New module, for use in implementing the scm_c_eval_string_from_file_line suggestion. * test-suite/Makefile.am: * test-suite/tests/eval-string.test: New tests. --- module/Makefile.am | 1 + module/ice-9/eval-string.scm | 88 +++++++++++++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/eval-string.test | 54 +++++++++++++++++++ 4 files changed, 144 insertions(+) create mode 100644 module/ice-9/eval-string.scm create mode 100644 test-suite/tests/eval-string.test diff --git a/module/Makefile.am b/module/Makefile.am index 16ce6d214..b39b82719 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -187,6 +187,7 @@ ICE_9_SOURCES = \ ice-9/curried-definitions.scm \ ice-9/debug.scm \ ice-9/documentation.scm \ + ice-9/eval-string.scm \ ice-9/expect.scm \ ice-9/format.scm \ ice-9/futures.scm \ diff --git a/module/ice-9/eval-string.scm b/module/ice-9/eval-string.scm new file mode 100644 index 000000000..27448d73f --- /dev/null +++ b/module/ice-9/eval-string.scm @@ -0,0 +1,88 @@ +;;; Evaluating code from users + +;;; Copyright (C) 2011 Free Software Foundation, Inc. + +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Code: + +(define-module (ice-9 eval-string) + #:use-module (system base compile) + #:use-module (system base language) + #:use-module (system vm program) + #:replace (eval-string)) + +(define (ensure-language x) + (if (language? x) + x + (lookup-language x))) + +(define* (read-and-eval port #:key (lang (current-language))) + (with-fluids ((*current-language* (ensure-language lang))) + (define (read) + ((language-reader (current-language)) port (current-module))) + (define (eval exp) + ((language-evaluator (current-language)) exp (current-module))) + + (let ((exp (read))) + (if (eof-object? exp) + ;; The behavior of read-and-compile and of the old + ;; eval-string. + *unspecified* + (let lp ((exp exp)) + (call-with-values + (lambda () (eval exp)) + (lambda vals + (let ((next (read))) + (cond + ((eof-object? next) + (apply values vals)) + (else + (lp next))))))))))) + +(define* (eval-string str #:key + (module (current-module)) + (file #f) + (line #f) + (column #f) + (lang (current-language)) + (compile? #f)) + (define (maybe-with-module module thunk) + (if module + (save-module-excursion + (lambda () + (set-current-module module) + (thunk))) + (thunk))) + + (let ((lang (ensure-language lang))) + (call-with-input-string + str + (lambda (port) + (maybe-with-module + module + (lambda () + (if module + (set-current-module module)) + (if file + (set-port-filename! port file)) + (if line + (set-port-line! port line)) + (if column + (set-port-column! port line)) + + (if (or compile? (not (language-evaluator lang))) + ((make-program (read-and-compile port #:from lang #:to 'objcode))) + (read-and-eval port #:lang lang)))))))) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 6cf1bd3d6..9273406e6 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -44,6 +44,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/elisp-compiler.test \ tests/elisp-reader.test \ tests/eval.test \ + tests/eval-string.test \ tests/exceptions.test \ tests/filesys.test \ tests/fluids.test \ diff --git a/test-suite/tests/eval-string.test b/test-suite/tests/eval-string.test new file mode 100644 index 000000000..8cef244bf --- /dev/null +++ b/test-suite/tests/eval-string.test @@ -0,0 +1,54 @@ +;;;; eval-string.test --- tests for (ice-9 eval-string) -*- scheme -*- +;;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-suite test-eval-string) + #:use-module (test-suite lib) + #:use-module (ice-9 eval-string)) + + +(with-test-prefix "basic" + (pass-if "eval none" + (equal? (eval-string "") *unspecified*)) + + (pass-if "eval single" + (equal? (eval-string "'foo") 'foo)) + + (pass-if "eval multiple" + (equal? (eval-string "'foo 'bar") 'bar)) + + (pass-if "compile none" + (equal? (eval-string "" #:compile? #t) *unspecified*)) + + (pass-if "compile single" + (equal? (eval-string "'foo" #:compile? #t) + 'foo)) + + (pass-if "compile multiple" + (equal? (eval-string "'foo 'bar" #:compile? #t) + 'bar)) + + (pass-if "eval values" + (equal? (call-with-values (lambda () + (eval-string "(values 1 2)")) + list) + '(1 2))) + + (pass-if "compile values" + (equal? (call-with-values (lambda () + (eval-string "(values 1 2)" #:compile? #t)) + list) + '(1 2)))) \ No newline at end of file From 691fcf66c0a823b2c4f4018e925cf9f338a4de27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 5 Mar 2011 20:15:09 +0100 Subject: [PATCH 071/183] Use a bytevector as the backing buffer of string ports. * libguile/strports.c (st_resize_port): Adjust to deal with OLD_STREAM and NEW_STREAM as bytevectors. (scm_mkstrport): Store a bytevector in the port's stream rather than a string. --- libguile/strports.c | 70 ++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index af601cf6e..3d951ce0b 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -30,7 +30,7 @@ #include #endif -#include "libguile/arrays.h" +#include "libguile/bytevectors.h" #include "libguile/eval.h" #include "libguile/ports.h" #include "libguile/read.h" @@ -55,15 +55,8 @@ /* NOTES: - We break the rules set forth by strings.h about accessing the - internals of strings here. We can do this since we can guarantee - that the string used as pt->stream is not in use by anyone else. - Thus, it's representation will not change asynchronously. - - (Ports aren't thread-safe yet anyway...) - - write_buf/write_end point to the ends of the allocated string. - read_buf/read_end in principle point to the part of the string which + write_buf/write_end point to the ends of the allocated bytevector. + read_buf/read_end in principle point to the part of the bytevector which has been written to, but this is only updated after a flush. read_pos and write_pos in principle should be equal, but this is only true when rw_active is SCM_PORT_NEITHER. @@ -106,25 +99,23 @@ stfill_buffer (SCM port) return scm_return_first_int (*pt->read_pos, port); } -/* change the size of a port's string to new_size. this doesn't - change read_buf_size. */ -static void +/* Change the size of a port's bytevector to NEW_SIZE. This doesn't + change `read_buf_size'. */ +static void st_resize_port (scm_t_port *pt, scm_t_off new_size) { SCM old_stream = SCM_PACK (pt->stream); - const char *src = scm_i_string_chars (old_stream); - char *dst; - SCM new_stream = scm_i_make_string (new_size, &dst); - unsigned long int old_size = scm_i_string_length (old_stream); + const signed char *src = SCM_BYTEVECTOR_CONTENTS (old_stream); + SCM new_stream = scm_c_make_bytevector (new_size); + signed char *dst = SCM_BYTEVECTOR_CONTENTS (new_stream); + unsigned long int old_size = SCM_BYTEVECTOR_LENGTH (old_stream); unsigned long int min_size = min (old_size, new_size); - unsigned long int i; scm_t_off index = pt->write_pos - pt->write_buf; pt->write_buf_size = new_size; - for (i = 0; i != min_size; ++i) - dst[i] = src[i]; + memcpy (dst, src, min_size); scm_remember_upto_here_1 (old_stream); @@ -292,13 +283,10 @@ st_truncate (SCM port, scm_t_off length) SCM scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) { - SCM z; + SCM z, buf; scm_t_port *pt; size_t str_len, c_pos; - char *buf, *c_str; - - SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); - c_pos = scm_to_unsigned_integer (pos, 0, scm_i_string_length (str)); + char *c_buf; if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); @@ -308,19 +296,31 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) z = scm_new_port_table_entry (scm_tc16_strport); pt = SCM_PTAB_ENTRY(z); - SCM_SETSTREAM (z, SCM_UNPACK (str)); + + { + /* STR is a string. */ + char *copy; + + SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); + + /* Create a copy of STR in the encoding of PT. */ + copy = scm_to_stringn (str, &str_len, pt->encoding, + SCM_FAILED_CONVERSION_ERROR); + buf = scm_c_make_bytevector (str_len); + c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); + memcpy (c_buf, copy, str_len); + free (copy); + + c_pos = scm_to_unsigned_integer (pos, 0, str_len); + pt->read_buf_size = str_len; + } + + SCM_SETSTREAM (z, SCM_UNPACK (buf)); SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); - /* Create a copy of STR in the encoding of Z. */ - buf = scm_to_stringn (str, &str_len, pt->encoding, - SCM_FAILED_CONVERSION_ERROR); - c_str = scm_gc_malloc_pointerless (str_len, "strport"); - memcpy (c_str, buf, str_len); - free (buf); - - pt->write_buf = pt->read_buf = (unsigned char *) c_str; + pt->write_buf = pt->read_buf = (unsigned char *) c_buf; pt->read_pos = pt->write_pos = pt->read_buf + c_pos; - pt->write_buf_size = pt->read_buf_size = str_len; + pt->write_buf_size = str_len; pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size; pt->rw_random = 1; From 0b2c2ba353d9dcf0b288950b88d6f205a5ec67ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 11:42:37 +0100 Subject: [PATCH 072/183] Let `scm_mkstrport' allocate buffers on the caller's behalf. * libguile/strports.c (INITIAL_BUFFER_SIZE): New macro. (scm_mkstrport): If STR is false, allocate a bytevector on the caller's behalf. (scm_object_to_string, scm_call_with_output_string, scm_open_output_string): Pass SCM_BOOL_F as the STR argument of `scm_mkstrport'. * libguile/backtrace.c (scm_display_application, display_backtrace_body): Likewise. * libguile/gdbint.c (scm_init_gdbint): Likewise. * libguile/print.c (scm_simple_format): Likewise. --- libguile/backtrace.c | 7 ++--- libguile/gdbint.c | 12 ++++----- libguile/print.c | 3 +-- libguile/strports.c | 61 +++++++++++++++++++++++++++----------------- 4 files changed, 46 insertions(+), 37 deletions(-) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index c7abe3173..7140228c2 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -278,9 +278,7 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0, scm_print_state *pstate; /* Create a string port used for adaptation of printing parameters. */ - sport = scm_mkstrport (SCM_INUM0, - scm_make_string (scm_from_int (240), - SCM_UNDEFINED), + sport = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_WRTNG, FUNC_NAME); @@ -473,8 +471,7 @@ display_backtrace_body (struct display_backtrace_args *a) SCM_ASSERT (n > 0, a->depth, SCM_ARG4, s_display_backtrace); /* Create a string port used for adaptation of printing parameters. */ - sport = scm_mkstrport (SCM_INUM0, - scm_make_string (scm_from_int (240), SCM_UNDEFINED), + sport = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_WRTNG, FUNC_NAME); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index 7cc9535d7..77fdbd17a 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -1,5 +1,5 @@ /* GDB interface for Guile - * Copyright (C) 1996,1997,1999,2000,2001,2002,2004,2009 + * Copyright (C) 1996,1997,1999,2000,2001,2002,2004,2009,2011 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -248,15 +248,13 @@ scm_init_gdbint () SCM port; scm_print_carefully_p = 0; - - port = scm_mkstrport (SCM_INUM0, - scm_c_make_string (0, SCM_UNDEFINED), + + port = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_WRTNG, s); gdb_output_port = scm_permanent_object (port); - - port = scm_mkstrport (SCM_INUM0, - scm_c_make_string (0, SCM_UNDEFINED), + + port = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_RDNG | SCM_WRTNG, s); gdb_input_port = scm_permanent_object (port); diff --git a/libguile/print.c b/libguile/print.c index 3855146b1..e3c9e1c92 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -1284,8 +1284,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, else if (scm_is_false (destination)) { fReturnString = 1; - port = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_INUM0, SCM_UNDEFINED), + port = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_WRTNG, FUNC_NAME); destination = port; diff --git a/libguile/strports.c b/libguile/strports.c index 3d951ce0b..83674e29e 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -280,6 +280,12 @@ st_truncate (SCM port, scm_t_off length) pt->write_pos = pt->read_end; } +/* The initial size in bytes of a string port's buffer. */ +#define INITIAL_BUFFER_SIZE 128 + +/* Return a new string port with MODES. If STR is #f, a new backing + buffer is allocated; otherwise STR must be a string and a copy of it + serves as the buffer for the new port. */ SCM scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) { @@ -297,23 +303,36 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) z = scm_new_port_table_entry (scm_tc16_strport); pt = SCM_PTAB_ENTRY(z); - { - /* STR is a string. */ - char *copy; + if (scm_is_false (str)) + { + /* Allocate a new buffer to write to. */ + str_len = INITIAL_BUFFER_SIZE; + buf = scm_c_make_bytevector (str_len); + c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); - SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); + /* Reset `read_buf_size'. It will contain the actual number of + bytes written to PT. */ + pt->read_buf_size = 0; + c_pos = 0; + } + else + { + /* STR is a string. */ + char *copy; - /* Create a copy of STR in the encoding of PT. */ - copy = scm_to_stringn (str, &str_len, pt->encoding, - SCM_FAILED_CONVERSION_ERROR); - buf = scm_c_make_bytevector (str_len); - c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); - memcpy (c_buf, copy, str_len); - free (copy); + SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); - c_pos = scm_to_unsigned_integer (pos, 0, str_len); - pt->read_buf_size = str_len; - } + /* Create a copy of STR in the encoding of PT. */ + copy = scm_to_stringn (str, &str_len, pt->encoding, + SCM_FAILED_CONVERSION_ERROR); + buf = scm_c_make_bytevector (str_len); + c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); + memcpy (c_buf, copy, str_len); + free (copy); + + c_pos = scm_to_unsigned_integer (pos, 0, str_len); + pt->read_buf_size = str_len; + } SCM_SETSTREAM (z, SCM_UNPACK (buf)); SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); @@ -369,13 +388,13 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, "argument @var{printer} (default: @code{write}).") #define FUNC_NAME s_scm_object_to_string { - SCM str, port; + SCM port; if (!SCM_UNBNDP (printer)) SCM_VALIDATE_PROC (2, printer); - str = scm_c_make_string (0, SCM_UNDEFINED); - port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_WRTNG, FUNC_NAME); + port = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, + SCM_OPN | SCM_WRTNG, FUNC_NAME); if (SCM_UNBNDP (printer)) scm_write (obj, port); @@ -395,8 +414,7 @@ SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, { SCM p; - p = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_INUM0, SCM_UNDEFINED), + p = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_WRTNG, FUNC_NAME); scm_call_1 (proc, p); @@ -441,8 +459,7 @@ SCM_DEFINE (scm_open_output_string, "open-output-string", 0, 0, 0, { SCM p; - p = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_INUM0, SCM_UNDEFINED), + p = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, SCM_OPN | SCM_WRTNG, FUNC_NAME); return p; @@ -467,8 +484,6 @@ SCM_DEFINE (scm_get_output_string, "get-output-string", 1, 0, 0, SCM scm_c_read_string (const char *expr) { - /* FIXME: the c string gets packed into a string, only to get - immediately unpacked in scm_mkstrport. */ SCM port = scm_mkstrport (SCM_INUM0, scm_from_locale_string (expr), SCM_OPN | SCM_RDNG, From d8f1c2162c3a34f4bc29ee7f6fab426e6e11e36a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 14:31:28 +0100 Subject: [PATCH 073/183] Simply grow string port buffers geometrically. * libguile/strports.c (SCM_WRITE_BLOCK): Remove. (st_flush): Multiply `pt->write_buf_size' by 2. (st_seek): Likewise when TARGET == PT->write_buf_size. --- libguile/strports.c | 28 +++++++--------------------- 1 file changed, 7 insertions(+), 21 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index 83674e29e..8a2cd5a8b 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -129,27 +129,17 @@ st_resize_port (scm_t_port *pt, scm_t_off new_size) } } -/* amount by which write_buf is expanded. */ -#define SCM_WRITE_BLOCK 80 - -/* ensure that write_pos < write_end by enlarging the buffer when - necessary. update read_buf to account for written chars. - - The buffer is enlarged by 1.5 times, plus SCM_WRITE_BLOCK. Adding just a - fixed amount is no good, because there's a block copy for each increment, - and that copying would take quadratic time. In the past it was found to - be very slow just adding 80 bytes each time (eg. about 10 seconds for - writing a 100kbyte string). */ - +/* Ensure that `write_pos' < `write_end' by enlarging the buffer when + necessary. Update `read_buf' to account for written chars. The + buffer is enlarged geometrically. */ static void st_flush (SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); if (pt->write_pos == pt->write_end) - { - st_resize_port (pt, pt->write_buf_size * 3 / 2 + SCM_WRITE_BLOCK); - } + st_resize_port (pt, pt->write_buf_size * 2); + pt->read_pos = pt->write_pos; if (pt->read_pos > pt->read_end) { @@ -246,12 +236,8 @@ st_seek (SCM port, scm_t_off offset, int whence) SCM_EOL); } } - else - { - st_resize_port (pt, target + (target == pt->write_buf_size - ? SCM_WRITE_BLOCK - : 0)); - } + else if (target == pt->write_buf_size) + st_resize_port (pt, target * 2); } pt->read_pos = pt->write_pos = pt->read_buf + target; if (pt->read_pos > pt->read_end) From ceed7709becfe64eaaff54aa445b09d1882d589d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 21:47:48 +0100 Subject: [PATCH 074/183] Slightly optimize `gensym'. * libguile/symbols.c (default_gensym_prefix): New variable. (scm_gensym): Use it. Use `scm_from_latin1_stringn' instead of `scm_from_locale_stringn'. (scm_init_symbols): Initialize DEFAULT_GENSYM_PREFIX. --- libguile/symbols.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/libguile/symbols.c b/libguile/symbols.c index b9d41b0e2..2a1b46dce 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -1,5 +1,6 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2009 Free Software Foundation, Inc. - * +/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, + * 2006, 2009, 2011 Free Software Foundation, Inc. + * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License * as published by the Free Software Foundation; either version 3 of @@ -341,6 +342,9 @@ SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, } #undef FUNC_NAME +/* The default prefix for `gensym'd symbols. */ +static SCM default_gensym_prefix; + #define MAX_PREFIX_LENGTH 30 SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, @@ -359,15 +363,15 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, char buf[SCM_INTBUFLEN]; if (SCM_UNBNDP (prefix)) - prefix = scm_from_locale_string (" g"); - + prefix = default_gensym_prefix; + /* mutex in case another thread looks and incs at the exact same moment */ scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); n = gensym_counter++; scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); n_digits = scm_iint2str (n, 10, buf); - suffix = scm_from_locale_stringn (buf, n_digits); + suffix = scm_from_latin1_stringn (buf, n_digits); name = scm_string_append (scm_list_2 (prefix, suffix)); return scm_string_to_symbol (name); } @@ -506,6 +510,8 @@ void scm_init_symbols () { #include "libguile/symbols.x" + + default_gensym_prefix = scm_from_latin1_string (" g"); } /* From 8b2633771269173b55e9808b030a9312e8554aef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 22:13:10 +0100 Subject: [PATCH 075/183] Make `object->string' explicitly close its string output port. * libguile/strports.c (scm_object_to_string): Close PORT before returning the resulting string. --- libguile/strports.c | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index 8a2cd5a8b..957c6a157 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -374,7 +374,7 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, "argument @var{printer} (default: @code{write}).") #define FUNC_NAME s_scm_object_to_string { - SCM port; + SCM port, result; if (!SCM_UNBNDP (printer)) SCM_VALIDATE_PROC (2, printer); @@ -387,7 +387,17 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, else scm_call_2 (printer, obj, port); - return scm_strport_to_string (port); + result = scm_strport_to_string (port); + + /* Explicitly close PORT so that the iconv CDs associated with it are + deallocated right away. This is important because CDs use a lot of + memory that's not visible to the GC, so not freeing them can lead + to almost large heap usage. See + + for details. */ + scm_close_port (port); + + return result; } #undef FUNC_NAME From 364b6eb7cfc39f18477b8f62c1e5d58a1efae69b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 22:26:49 +0100 Subject: [PATCH 076/183] Add `gc-benchmarks/' to the distribution. * gc-benchmarks/Makefile.am: New file. * configure.ac: Produce it. * Makefile.am (SUBDIRS): Add `gc-benchmarks'. --- Makefile.am | 4 ++- configure.ac | 1 + gc-benchmarks/Makefile.am | 55 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 59 insertions(+), 1 deletion(-) create mode 100644 gc-benchmarks/Makefile.am diff --git a/Makefile.am b/Makefile.am index 27f799709..3a97683e8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,7 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, +## 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -34,6 +35,7 @@ SUBDIRS = \ emacs \ test-suite \ benchmark-suite \ + gc-benchmarks \ am \ doc diff --git a/configure.ac b/configure.ac index 992906401..ba6ff4900 100644 --- a/configure.ac +++ b/configure.ac @@ -1618,6 +1618,7 @@ AC_CONFIG_FILES([ am/Makefile lib/Makefile benchmark-suite/Makefile + gc-benchmarks/Makefile doc/Makefile doc/r5rs/Makefile doc/ref/Makefile diff --git a/gc-benchmarks/Makefile.am b/gc-benchmarks/Makefile.am new file mode 100644 index 000000000..0fdbcdcea --- /dev/null +++ b/gc-benchmarks/Makefile.am @@ -0,0 +1,55 @@ +## Process this file with automake to produce Makefile.in. +## +## Copyright (C) 2011 Free Software Foundation, Inc. +## +## This file is part of GUILE. +## +## GUILE is free software; you can redistribute it and/or modify it +## under the terms of the GNU Lesser General Public License as +## published by the Free Software Foundation; either version 3, or +## (at your option) any later version. +## +## GUILE is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU Lesser General Public License for more details. +## +## You should have received a copy of the GNU Lesser General Public +## License along with GUILE; see the file COPYING.LESSER. If not, +## write to the Free Software Foundation, Inc., 51 Franklin Street, +## Fifth Floor, Boston, MA 02110-1301 USA + +EXTRA_DIST = \ + gc-profile.scm \ + gcbench.scm \ + guile-test.scm \ + loop.scm \ + run-benchmark.scm \ + string.scm \ + $(benchmarks) + +# GPLv2+ Larceny GC benchmarks by Lars Hansen et al. from +# . +benchmarks = \ + larceny/GPL \ + larceny/README \ + larceny/dumb.sch \ + larceny/dummy.sch \ + larceny/dynamic-input-large.sch \ + larceny/dynamic-input-small.sch \ + larceny/dynamic.sch \ + larceny/earley.sch \ + larceny/gcbench.sch \ + larceny/gcold.scm \ + larceny/graphs.sch \ + larceny/lattice.sch \ + larceny/nboyer.sch \ + larceny/nucleic2.sch \ + larceny/perm.sch \ + larceny/run-benchmark.chez \ + larceny/sboyer.sch \ + larceny/softscheme.sch \ + larceny/twobit-input-long.sch \ + larceny/twobit-input-short.sch \ + larceny/twobit-smaller.sch \ + larceny/twobit.sch From 821eca02eb50cb65d41f72fe99acbebd5bc5cc7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 22:27:53 +0100 Subject: [PATCH 077/183] Have `gc-profile.scm' make sure it's on a Linux-based system. * gc-benchmarks/gc-profile.scm (memory-mappings): Check %HOST-TYPE for "-linux-". --- gc-benchmarks/gc-profile.scm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/gc-benchmarks/gc-profile.scm b/gc-benchmarks/gc-profile.scm index 667886ea5..d95e29572 100755 --- a/gc-benchmarks/gc-profile.scm +++ b/gc-benchmarks/gc-profile.scm @@ -47,6 +47,9 @@ memory mapping of process @var{pid}. This information is obtained by reading (make-regexp "^Rss:[[:blank:]]+([[:digit:]]+) kB$")) + (if (not (string-contains %host-type "-linux-")) + (error "this procedure only works on Linux-based systems" %host-type)) + (with-input-from-port (open-input-file (format #f "/proc/~a/smaps" pid)) (lambda () (let loop ((line (read-line)) From 65ea26c5824bc3be9d327b4470d19e67d7b5d44d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Mar 2011 23:02:57 +0100 Subject: [PATCH 078/183] Handle `letrec*' like `letrec' in simple cases. * module/language/tree-il/fix-letrec.scm (fix-letrec!): When X is a `letrec*' with only lambdas and simple expressions, analyze it as if it were a `letrec'. * test-suite/tests/tree-il.test ("letrec"): Add test for `(letrec* (x y) (xx yy) ((const 1) (const 2)) (lexical y yy))'. --- module/language/tree-il/fix-letrec.scm | 141 ++++++++++++++----------- test-suite/tests/tree-il.test | 13 ++- 2 files changed, 94 insertions(+), 60 deletions(-) diff --git a/module/language/tree-il/fix-letrec.scm b/module/language/tree-il/fix-letrec.scm index 8d4b2391b..ee8beb2e6 100644 --- a/module/language/tree-il/fix-letrec.scm +++ b/module/language/tree-il/fix-letrec.scm @@ -1,6 +1,6 @@ ;;; transformation of letrec into simpler forms -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -190,64 +190,83 @@ x)) (( src in-order? names gensyms vals body) - (let ((binds (map list gensyms names vals))) - ;; The bindings returned by this function need to appear in the same - ;; order that they appear in the letrec. - (define (lookup set) - (let lp ((binds binds)) - (cond - ((null? binds) '()) - ((memq (caar binds) set) - (cons (car binds) (lp (cdr binds)))) - (else (lp (cdr binds)))))) - (let ((u (lookup unref)) - (s (lookup simple)) - (l (lookup lambda*)) - (c (lookup complex))) - ;; Bind "simple" bindings, and locations for complex - ;; bindings. - (make-let - src - (append (map cadr s) (map cadr c)) - (append (map car s) (map car c)) - (append (map caddr s) (map (lambda (x) (make-void #f)) c)) - ;; Bind lambdas using the fixpoint operator. - (make-fix - src (map cadr l) (map car l) (map caddr l) - (make-sequence - src - (append - ;; The right-hand-sides of the unreferenced - ;; bindings, for effect. - (map caddr u) - (cond - ((null? c) - ;; No complex bindings, just emit the body. - (list body)) - (in-order? - ;; For letrec*, assign complex bindings in order, then the - ;; body. - (append - (map (lambda (c) - (make-lexical-set #f (cadr c) (car c) (caddr c))) - c) - (list body))) - (else - ;; Otherwise for plain letrec, evaluate the the "complex" - ;; bindings, in a `let' to indicate that order doesn't - ;; matter, and bind to their variables. - (list - (let ((tmps (map (lambda (x) (gensym)) c))) - (make-let - #f (map cadr c) tmps (map caddr c) - (make-sequence - #f - (map (lambda (x tmp) - (make-lexical-set - #f (cadr x) (car x) - (make-lexical-ref #f (cadr x) tmp))) - c tmps)))) - body)))))))))) + (if (and in-order? + (every (lambda (x) + (or (lambda? x) + (simple-expression? + x gensyms + effect+exception-free-primitive?))) + vals)) + ;; If it is a `letrec*', return an equivalent `letrec' when + ;; it's possible. This is a hack until we implement the + ;; algorithm described in "Fixing Letrec (Reloaded)" + ;; (Ghuloum and Dybvig) to allow cases such as + ;; (letrec* ((f (lambda () ...))(g (lambda () ...))) ...) + ;; or + ;; (letrec* ((x 2)(y 3)) y) + ;; to be optimized. These can be common when using + ;; internal defines. + (fix-letrec! + (make-letrec src #f names gensyms vals body)) + (let ((binds (map list gensyms names vals))) + ;; The bindings returned by this function need to appear in the same + ;; order that they appear in the letrec. + (define (lookup set) + (let lp ((binds binds)) + (cond + ((null? binds) '()) + ((memq (caar binds) set) + (cons (car binds) (lp (cdr binds)))) + (else (lp (cdr binds)))))) + (let ((u (lookup unref)) + (s (lookup simple)) + (l (lookup lambda*)) + (c (lookup complex))) + ;; Bind "simple" bindings, and locations for complex + ;; bindings. + (make-let + src + (append (map cadr s) (map cadr c)) + (append (map car s) (map car c)) + (append (map caddr s) (map (lambda (x) (make-void #f)) c)) + ;; Bind lambdas using the fixpoint operator. + (make-fix + src (map cadr l) (map car l) (map caddr l) + (make-sequence + src + (append + ;; The right-hand-sides of the unreferenced + ;; bindings, for effect. + (map caddr u) + (cond + ((null? c) + ;; No complex bindings, just emit the body. + (list body)) + (in-order? + ;; For letrec*, assign complex bindings in order, then the + ;; body. + (append + (map (lambda (c) + (make-lexical-set #f (cadr c) (car c) + (caddr c))) + c) + (list body))) + (else + ;; Otherwise for plain letrec, evaluate the the "complex" + ;; bindings, in a `let' to indicate that order doesn't + ;; matter, and bind to their variables. + (list + (let ((tmps (map (lambda (x) (gensym)) c))) + (make-let + #f (map cadr c) tmps (map caddr c) + (make-sequence + #f + (map (lambda (x tmp) + (make-lexical-set + #f (cadr x) (car x) + (make-lexical-ref #f (cadr x) tmp))) + c tmps)))) + body))))))))))) (( src names gensyms vals body) (let ((binds (map list gensyms names vals))) @@ -271,3 +290,7 @@ (else x))) x))) + +;;; Local Variables: +;;; eval: (put 'record-case 'scheme-indent-function 1) +;;; End: diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index 76c825dd1..8ea244343 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -363,7 +363,18 @@ (lexical #t #t set 1) (lexical #t #t ref 0) (lexical #t #t ref 1) - (call add 2) (call return 1) (unbind)))) + (call add 2) (call return 1) (unbind))) + + ;; simple bindings in letrec* -> equivalent to letrec + (assert-tree-il->glil + (letrec* (x y) (xx yy) ((const 1) (const 2)) + (lexical y yy)) + (program () (std-prelude 0 1 #f) (label _) + (const 2) + (bind (y #f 0)) ;; X is removed, and Y is unboxed + (lexical #t #f set 0) + (lexical #t #f ref 0) + (call return 1) (unbind)))) (with-test-prefix "lambda" (assert-tree-il->glil From ef8e9356de2494d378948614945ec9aa4498d91c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 09:27:23 +0100 Subject: [PATCH 079/183] add scm_c_public_ref et al * libguile/modules.h: * libguile/modules.c (scm_public_lookup, scm_private_lookup) (scm_c_public_lookup, scm_c_private_lookup, scm_public_ref) (scm_private_ref, scm_c_public_ref, scm_c_private_ref) (scm_public_variable, scm_private_variable, scm_c_public_variable) (scm_c_private_variable): New helpers to get at variables and values in modules. --- libguile/modules.c | 122 +++++++++++++++++++++++++++++++++++++++++++++ libguile/modules.h | 17 ++++++- 2 files changed, 138 insertions(+), 1 deletion(-) diff --git a/libguile/modules.c b/libguile/modules.c index 40f9c84b1..e06082186 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -56,6 +56,9 @@ static SCM module_public_interface_var; static SCM module_export_x_var; static SCM default_duplicate_binding_procedures_var; +/* The #:ensure keyword. */ +static SCM k_ensure; + static SCM unbound_variable (const char *func, SCM sym) { @@ -751,6 +754,124 @@ scm_lookup (SCM sym) return var; } +SCM +scm_public_variable (SCM module_name, SCM name) +{ + SCM mod, iface; + + mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name, + k_ensure, SCM_BOOL_F); + + if (scm_is_false (mod)) + scm_misc_error ("public-lookup", "Module named ~s does not exist", + scm_list_1 (module_name)); + + iface = scm_module_public_interface (mod); + + if (scm_is_false (iface)) + scm_misc_error ("public-lookup", "Module ~s has no public interface", + scm_list_1 (mod)); + + return scm_module_variable (iface, name); +} + +SCM +scm_private_variable (SCM module_name, SCM name) +{ + SCM mod; + + mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name, + k_ensure, SCM_BOOL_F); + + if (scm_is_false (mod)) + scm_misc_error ("private-lookup", "Module named ~s does not exist", + scm_list_1 (module_name)); + + return scm_module_variable (mod, name); +} + +SCM +scm_c_public_variable (const char *module_name, const char *name) +{ + return scm_public_variable (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_c_private_variable (const char *module_name, const char *name) +{ + return scm_private_variable (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_public_lookup (SCM module_name, SCM name) +{ + SCM var; + + var = scm_public_variable (module_name, name); + + if (scm_is_false (var)) + scm_misc_error ("public-lookup", "No variable bound to ~s in module ~s", + scm_list_2 (name, module_name)); + + return var; +} + +SCM +scm_private_lookup (SCM module_name, SCM name) +{ + SCM var; + + var = scm_private_variable (module_name, name); + + if (scm_is_false (var)) + scm_misc_error ("private-lookup", "No variable bound to ~s in module ~s", + scm_list_2 (name, module_name)); + + return var; +} + +SCM +scm_c_public_lookup (const char *module_name, const char *name) +{ + return scm_public_lookup (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_c_private_lookup (const char *module_name, const char *name) +{ + return scm_private_lookup (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_public_ref (SCM module_name, SCM name) +{ + return scm_variable_ref (scm_public_lookup (module_name, name)); +} + +SCM +scm_private_ref (SCM module_name, SCM name) +{ + return scm_variable_ref (scm_private_lookup (module_name, name)); +} + +SCM +scm_c_public_ref (const char *module_name, const char *name) +{ + return scm_public_ref (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_c_private_ref (const char *module_name, const char *name) +{ + return scm_private_ref (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + SCM scm_c_module_define (SCM module, const char *name, SCM value) { @@ -903,6 +1024,7 @@ scm_post_boot_init_modules () default_duplicate_binding_procedures_var = scm_c_lookup ("default-duplicate-binding-procedures"); module_public_interface_var = scm_c_lookup ("module-public-interface"); + k_ensure = scm_from_locale_keyword ("ensure"); scm_module_system_booted_p = 1; } diff --git a/libguile/modules.h b/libguile/modules.h index aef7d3beb..07dc2c3c4 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -93,6 +93,21 @@ SCM_API SCM scm_module_define (SCM module, SCM symbol, SCM val); SCM_API SCM scm_module_export (SCM module, SCM symbol_list); SCM_API SCM scm_module_reverse_lookup (SCM module, SCM variable); +SCM_API SCM scm_public_variable (SCM module_name, SCM name); +SCM_API SCM scm_private_variable (SCM module_name, SCM name); +SCM_API SCM scm_c_public_variable (const char *module_name, const char *name); +SCM_API SCM scm_c_private_variable (const char *module_name, const char *name); + +SCM_API SCM scm_public_lookup (SCM module_name, SCM name); +SCM_API SCM scm_private_lookup (SCM module_name, SCM name); +SCM_API SCM scm_c_public_lookup (const char *module_name, const char *name); +SCM_API SCM scm_c_private_lookup (const char *module_name, const char *name); + +SCM_API SCM scm_public_ref (SCM module_name, SCM name); +SCM_API SCM scm_private_ref (SCM module_name, SCM name); +SCM_API SCM scm_c_public_ref (const char *module_name, const char *name); +SCM_API SCM scm_c_private_ref (const char *module_name, const char *name); + SCM_API SCM scm_c_resolve_module (const char *name); SCM_API SCM scm_resolve_module (SCM name); SCM_API SCM scm_c_define_module (const char *name, From 0b0e066a26b437f7320abd126ec05a7a7c056dd9 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 09:29:24 +0100 Subject: [PATCH 080/183] core eval-string uses (ice-9 eval-string) * libguile/strports.c (scm_eval_string_in_module): Use eval-string from (ice-9 eval-string). --- libguile/strports.c | 33 ++++++++++----------------------- 1 file changed, 10 insertions(+), 23 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index 957c6a157..594d03011 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -507,25 +507,6 @@ scm_c_eval_string_in_module (const char *expr, SCM module) } -static SCM -inner_eval_string (void *data) -{ - SCM port = (SCM)data; - SCM form; - SCM ans = SCM_UNSPECIFIED; - - /* Read expressions from that port; ignore the values. */ - while (!SCM_EOF_OBJECT_P (form = scm_read (port))) - ans = scm_primitive_eval_x (form); - - /* Don't close the port here; if we re-enter this function via a - continuation, then the next time we enter it, we'll get an error. - It's a string port anyway, so there's no advantage to closing it - early. */ - - return ans; -} - SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, (SCM string, SCM module), "Evaluate @var{string} as the text representation of a Scheme\n" @@ -537,14 +518,20 @@ SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, "procedure returns.") #define FUNC_NAME s_scm_eval_string_in_module { - SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG, - FUNC_NAME); + static SCM eval_string = SCM_BOOL_F, k_module = SCM_BOOL_F; + + if (scm_is_false (eval_string)) + { + eval_string = scm_c_public_lookup ("ice-9 eval-string", "eval-string"); + k_module = scm_from_locale_keyword ("module"); + } + if (SCM_UNBNDP (module)) module = scm_current_module (); else SCM_VALIDATE_MODULE (2, module); - return scm_c_call_with_current_module (module, - inner_eval_string, (void *)port); + + return scm_call_3 (scm_variable_ref (eval_string), string, k_module, module); } #undef FUNC_NAME From 534491d0b7fcd17558751110610bcef971d414a8 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 09:30:33 +0100 Subject: [PATCH 081/183] fix scm_setter * libguile/procs.c (scm_setter): Only get at the setter slot if the pure generic actually has a setter. Needs test. * test-suite/tests/goops.test ("defining generics"): ("defining accessors"): Add `setter' tests. --- libguile/procs.c | 3 ++- test-suite/tests/goops.test | 11 +++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/libguile/procs.c b/libguile/procs.c index 2b7225efe..a096591df 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -149,7 +149,8 @@ SCM_PRIMITIVE_GENERIC (scm_setter, "setter", 1, 0, 0, SCM_GASSERT1 (SCM_STRUCTP (proc), g_scm_setter, proc, SCM_ARG1, FUNC_NAME); if (SCM_STRUCT_SETTER_P (proc)) return SCM_STRUCT_SETTER (proc); - if (SCM_PUREGENERICP (proc)) + if (SCM_PUREGENERICP (proc) + && SCM_IS_A_P (proc, scm_class_generic_with_setter)) /* FIXME: might not be an accessor */ return SCM_GENERIC_SETTER (proc); SCM_WTA_DISPATCH_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME); diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 908d1e7ae..2bf7d698b 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -1,6 +1,6 @@ ;;;; goops.test --- test suite for GOOPS -*- scheme -*- ;;;; -;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -234,7 +234,11 @@ (eval '(define-generic foo) (current-module)) (eval '(and (is-a? foo ) (null? (generic-function-methods foo))) - (current-module))))) + (current-module))) + + (pass-if-exception "getters do not have setters" + exception:wrong-type-arg + (eval '(setter foo) (current-module))))) (with-test-prefix "defining methods" @@ -294,6 +298,9 @@ (null? (generic-function-methods foo-1))) (current-module))) + (pass-if "accessors have setters" + (procedure? (eval '(setter foo-1) (current-module)))) + (pass-if "overwriting a top-level binding to a non-accessor" (eval '(define (foo) #f) (current-module)) (eval '(define-accessor foo) (current-module)) From f32e67be0b1390f22382eed10459016ca37c126d Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 20:57:41 +0100 Subject: [PATCH 082/183] add scm_call_{5,6} * libguile/eval.h: * libguile/eval.c (scm_call_5, scm_call_6): New scm_call functions; why not. --- libguile/eval.c | 15 +++++++++++++++ libguile/eval.h | 6 +++++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/libguile/eval.c b/libguile/eval.c index b52cc2788..e66071410 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -476,6 +476,21 @@ scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4) return scm_c_vm_run (scm_the_vm (), proc, args, 4); } +SCM +scm_call_5 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5) +{ + SCM args[] = { arg1, arg2, arg3, arg4, arg5 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 5); +} + +SCM +scm_call_6 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5, + SCM arg6) +{ + SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 6); +} + SCM scm_call_n (SCM proc, SCM *argv, size_t nargs) { diff --git a/libguile/eval.h b/libguile/eval.h index 969cce129..f193ad64e 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -3,7 +3,7 @@ #ifndef SCM_EVAL_H #define SCM_EVAL_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -68,6 +68,10 @@ SCM_API SCM scm_call_1 (SCM proc, SCM arg1); SCM_API SCM scm_call_2 (SCM proc, SCM arg1, SCM arg2); SCM_API SCM scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3); SCM_API SCM scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4); +SCM_API SCM scm_call_5 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, + SCM arg5); +SCM_API SCM scm_call_6 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, + SCM arg5, SCM arg6); SCM_API SCM scm_call_n (SCM proc, SCM *argv, size_t nargs); SCM_API SCM scm_apply_0 (SCM proc, SCM args); SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args); From 13459a961946526dc8f1277a6d4d319f848da1ab Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 21:06:12 +0100 Subject: [PATCH 083/183] document scm_call_{5,6,n} * doc/ref/api-evaluation.texi (Fly Evaluation): Document scm_call_{5,6,n}. --- doc/ref/api-evaluation.texi | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index b976715db..16bfaf05a 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -493,9 +493,17 @@ then there's no @var{arg1}@dots{}@var{argN} and @var{arg} is the @deffnx {C Function} scm_call_2 (proc, arg1, arg2) @deffnx {C Function} scm_call_3 (proc, arg1, arg2, arg3) @deffnx {C Function} scm_call_4 (proc, arg1, arg2, arg3, arg4) +@deffnx {C Function} scm_call_5 (proc, arg1, arg2, arg3, arg4, arg5) +@deffnx {C Function} scm_call_6 (proc, arg1, arg2, arg3, arg4, arg5, arg6) Call @var{proc} with the given arguments. @end deffn +@deffn {C Function} scm_call_n (proc, argv, nargs) +Call @var{proc} with the array of arguments @var{argv}, as a +@code{SCM*}. The length of the arguments should be passed in +@var{nargs}, as a @code{size_t}. +@end deffn + @deffn {Scheme Procedure} apply:nconc2last lst @deffnx {C Function} scm_nconc2last (lst) @var{lst} should be a list (@var{arg1} @dots{} @var{argN} From c2e56d9b0727d50a90917ea6b79f17ebe2d35c98 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 21:53:02 +0100 Subject: [PATCH 084/183] eval-string docs * doc/ref/api-evaluation.texi (Fly Evaluation): Update eval-string documentation. --- doc/ref/api-evaluation.texi | 49 +++++++++++++++++++++++++++++-------- 1 file changed, 39 insertions(+), 10 deletions(-) diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index 16bfaf05a..682e84498 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -426,7 +426,9 @@ Modify the print options. @node Fly Evaluation @subsection Procedures for On the Fly Evaluation -@xref{Environments}. +Scheme has the lovely property that its expressions may be represented +as data. The @code{eval} procedure takes a Scheme datum and evaluates +it as code. @rnindex eval @c ARGFIXME environment/environment specifier @@ -451,19 +453,46 @@ return the environment in which the implementation would evaluate expressions dynamically typed by the user. @end deffn -@deffn {Scheme Procedure} eval-string string [module] -@deffnx {C Function} scm_eval_string (string) +@xref{Environments}, for other environments. + +One does not always receive code as Scheme data, of course, and this is +especially the case for Guile's other language implementations +(@pxref{Other Languages}). For the case in which all you have is a +string, we have @code{eval-string}. There is a legacy version of this +procedure in the default environment, but you really want the one from +@code{(ice-9 eval-string)}, so load it up: + +@example +(use-modules (ice-9 eval-string)) +@end example + +@deffn {Scheme Procedure} eval-string string [module=#f] [file=#f] [line=#f] [column=#f] [lang=(current-language)] [compile?=#f] +Parse @var{string} according to the current language, normally Scheme. +Evaluate or compile the expressions it contains, in order, returning the +last expression. + +If the @var{module} keyword argument is set, save a module excursion +(@pxref{Module System Reflection}) and set the current module to +@var{module} before evaluation. + +The @var{file}, @var{line}, and @var{column} keyword arguments can be +used to indicate that the source string begins at a particular source +location. + +Finally, @var{lang} is a language, defaulting to the current language, +and the expression is compiled if @var{compile?} is true or there is no +evaluator for the given language. +@end deffn + +@deffn {C Function} scm_eval_string (string) @deffnx {C Function} scm_eval_string_in_module (string, module) -Evaluate @var{string} as the text representation of a Scheme form or -forms, and return whatever value they produce. Evaluation takes place -in the given module, or in the current module when no module is given. -While the code is evaluated, the given module is made the current one. -The current module is restored when this procedure returns. +These C bindings call @code{eval-string} from @code{(ice-9 +eval-string)}, evaluating within @var{module} or the current module. @end deffn @deftypefn {C Function} SCM scm_c_eval_string (const char *string) -@code{scm_eval_string}, but taking a C string instead of an -@code{SCM}. +@code{scm_eval_string}, but taking a C string in locale encoding instead +of an @code{SCM}. @end deftypefn @deffn {Scheme Procedure} apply proc arg1 @dots{} argN arglst From 831e6782bfa776c30286ef14f1356b9d5aa8f1ee Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 8 Mar 2011 22:34:53 +0100 Subject: [PATCH 085/183] scm_public_ref et al docs * doc/ref/api-modules.texi (Accessing Modules from C): Add docs for the new C procedures. --- doc/ref/api-modules.texi | 65 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 64 insertions(+), 1 deletion(-) diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi index e0c10ae51..3feced4be 100644 --- a/doc/ref/api-modules.texi +++ b/doc/ref/api-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, 2009, 2010 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, 2009, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -935,6 +935,62 @@ value of @code{scm_c_call_with_current_module} is the return value of @var{func}. @end deftypefn +@deftypefn SCM scm_public_variable (SCM @var{module_name}, SCM @var{name}) +@deftypefnx SCM scm_c_public_variable (const char * @var{module_name}, const char * @var{name}) +Find a the variable bound to the symbol @var{name} in the public +interface of the module named @var{module_name}. + + @var{module_name} should be a list of symbols, when represented as a +Scheme object, or a space-separated string, in the @code{const char *} +case. See @code{scm_c_define_module} below, for more examples. + +Signals an error if no module was found with the given name. If +@var{name} is not bound in the module, just returns @code{#f}. +@end deftypefn + +@deftypefn SCM scm_private_variable (SCM @var{module_name}, SCM @var{name}) +@deftypefnx SCM scm_c_private_variable (const char * @var{module_name}, const char * @var{name}) +Like @code{scm_public_variable}, but looks in the internals of the +module named @var{module_name} instead of the public interface. +Logically, these procedures should only be called on modules you write. +@end deftypefn + +@deftypefn SCM scm_public_lookup (SCM @var{module_name}, SCM @var{name}) +@deftypefnx SCM scm_c_public_lookup (const char * @var{module_name}, const char * @var{name}) +@deftypefnx SCM scm_private_lookup (SCM @var{module_name}, SCM @var{name}) +@deftypefnx SCM scm_c_private_lookup (const char * @var{module_name}, const char * @var{name}) +Like @code{scm_public_variable} or @code{scm_private_variable}, but if +the @var{name} is not bound in the module, signals an error. Returns a +variable, always. + +@example +SCM my_eval_string (SCM str) +@{ + static SCM eval_string_var = SCM_BOOL_F; + + if (scm_is_false (eval_string_var)) + eval_string_var = + scm_c_public_lookup ("ice-9 eval-string", "eval-string"); + + return scm_call_1 (scm_variable_ref (eval_string_var), str); +@} +@end example +@end deftypefn + +@deftypefn SCM scm_public_ref (SCM @var{module_name}, SCM @var{name}) +@deftypefnx SCM scm_c_public_ref (const char * @var{module_name}, const char * @var{name}) +@deftypefnx SCM scm_private_ref (SCM @var{module_name}, SCM @var{name}) +@deftypefnx SCM scm_c_private_ref (const char * @var{module_name}, const char * @var{name}) +Like @code{scm_public_lookup} or @code{scm_private_lookup}, but +additionally dereferences the variable. If the variable object is +unbound, signals an error. Returns the value bound to @var{name} in +@var{module}. +@end deftypefn + +In addition, there are a number of other lookup-related procedures. We +suggest that you use the @code{scm_public_} and @code{scm_private_} +family of procedures instead, if possible. + @deftypefn {C Procedure} SCM scm_c_lookup (const char *@var{name}) Return the variable bound to the symbol indicated by @var{name} in the current module. If there is no such binding or the symbol is not @@ -951,6 +1007,13 @@ Like @code{scm_c_lookup} and @code{scm_lookup}, but the specified module is used instead of the current one. @end deftypefn +@deftypefn {C Procedure} SCM scm_module_variable (SCM @var{module}, SCM @var{name}) +Like @code{scm_module_lookup}, but if the binding does not exist, just +returns @code{#f} instead of raising an error. +@end deftypefn + +To define a value, use @code{scm_define}: + @deftypefn {C Procedure} SCM scm_c_define (const char *@var{name}, SCM @var{val}) Bind the symbol indicated by @var{name} to a variable in the current module and set that variable to @var{val}. When @var{name} is already From 73ea546c51c5ca531cc6040eb37e292a8334b33e Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Mar 2011 12:46:38 -0500 Subject: [PATCH 086/183] Fix bytevectors VALIDATE_REAL to test for reals, not rationals Reported and fixed by Daniel Llorens . * libguile/bytevectors.c (VALIDATE_REAL): Test for reals, not rationals. * test-suite/tests/srfi-4.test (f32 vectors, f64 vectors): Add tests. --- libguile/bytevectors.c | 2 +- test-suite/tests/srfi-4.test | 10 ++++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index f01469774..a969e3bb4 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -1667,7 +1667,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source) /* FIXME: SCM_VALIDATE_REAL rejects integers, etc. grrr */ #define VALIDATE_REAL(pos, v) \ do { \ - SCM_ASSERT_TYPE (scm_is_true (scm_rational_p (v)), v, pos, FUNC_NAME, "real"); \ + SCM_ASSERT_TYPE (scm_is_real (v), v, pos, FUNC_NAME, "real"); \ } while (0) /* Templace getters and setters. */ diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index d7e5b1adf..0cdfb6699 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -352,7 +352,10 @@ (pass-if "make-f32vector" (equal? (list->f32vector '(7 7 7 7)) - (make-f32vector 4 7)))) + (make-f32vector 4 7))) + + (pass-if "+inf.0, -inf.0, +nan.0 in f32vector" + (f32vector? #f32(+inf.0 -inf.0 +nan.0)))) (with-test-prefix "f64 vectors" @@ -389,4 +392,7 @@ (pass-if "make-f64vector" (equal? (list->f64vector '(7 7 7 7)) - (make-f64vector 4 7)))) + (make-f64vector 4 7))) + + (pass-if "+inf.0, -inf.0, +nan.0 in f64vector" + (f64vector? #f64(+inf.0 -inf.0 +nan.0)))) From 4f1bbedb6db54acc0a0ceea81dc79220bbbcb1b3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Mar 2011 12:37:01 -0500 Subject: [PATCH 087/183] Fix description of the R6RS `finite?' in manual * doc/ref/r6rs.texi (rnrs base): `(finite? x)' returns true iff x is neither infinite nor a NaN. Previously, it stated that `finite?' was the negation of `infinite?', which was incorrect because NaNs are neither finite nor infinite. Combine description of 'nan?' with those of `finite?' and `infinite?'. --- doc/ref/r6rs.texi | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi index c1ac54124..8f8928659 100644 --- a/doc/ref/r6rs.texi +++ b/doc/ref/r6rs.texi @@ -356,7 +356,6 @@ grouped below by the existing manual sections to which they correspond. @deffn {Scheme Procedure} real? x @deffnx {Scheme Procedure} rational? x -@deffnx {Scheme Procedure} nan? x @deffnx {Scheme Procedure} numerator x @deffnx {Scheme Procedure} denominator x @deffnx {Scheme Procedure} rationalize x eps @@ -542,11 +541,15 @@ loss of numerical precision. imaginary parts are zero. @end deffn -@deffn {Scheme Procedure} finite? x +@deffn {Scheme Procedure} nan? x @deffnx {Scheme Procedure} infinite? x -@code{infinite?} returns @code{#t} if @var{x} is an infinite value, -@code{#f} otherwise. @code{finite?} returns the negation of -@code{infinite?}. +@deffnx {Scheme Procedure} finite? x +@code{nan?} returns @code{#t} if @var{x} is a NaN value, @code{#f} +otherwise. @code{infinite?} returns @code{#t} if @var{x} is an infinite +value, @code{#f} otherwise. @code{finite?} returns @code{#t} if @var{x} +is neither infinite nor a NaN value, otherwise it returns @code{#f}. +Every real number satisfies exactly one of these predicates. An +exception is raised if @var{x} is not real. @end deffn @deffn {Scheme Syntax} assert expr From 18d78c5e3585b06e5f588ba1ae919e189afeaa73 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 22 Feb 2011 21:39:37 -0500 Subject: [PATCH 088/183] Update comments regarding GMP earlier than 4.2. * libguile/numbers.c: Update comments regarding GMP earlier than 4.2. Remove speculations about versions of GMP that had not yet been released when the comments were written. Replace them with facts that are now known about the changes made in GMP 4.2. --- libguile/numbers.c | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index b8cfa5dc9..be86eb575 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -134,9 +134,9 @@ static double acosh (double x) { return log (x + sqrt (x * x - 1)); } static double atanh (double x) { return 0.5 * log ((1 + x) / (1 - x)); } #endif -/* mpz_cmp_d in gmp 4.1.3 doesn't recognise infinities, so xmpz_cmp_d uses - an explicit check. In some future gmp (don't know what version number), - mpz_cmp_d is supposed to do this itself. */ +/* mpz_cmp_d in GMP before 4.2 didn't recognise infinities, so + xmpz_cmp_d uses an explicit check. Starting with GMP 4.2 (released + in March 2006), mpz_cmp_d now handles infinities properly. */ #if 1 #define xmpz_cmp_d(z, d) \ (isinf (d) ? (d < 0.0 ? 1 : -1) : mpz_cmp_d (z, d)) @@ -316,16 +316,15 @@ scm_i_dbl2num (double u) we need to use mpz_getlimbn. mpz_tstbit is not right, it treats negatives as twos complement. - In current gmp 4.1.3, mpz_get_d rounding is unspecified. It ends up - following the hardware rounding mode, but applied to the absolute value - of the mpz_t operand. This is not what we want so we put the high - DBL_MANT_DIG bits into a temporary. In some future gmp, don't know when, - mpz_get_d is supposed to always truncate towards zero. + In GMP before 4.2, mpz_get_d rounding was unspecified. It ended up + following the hardware rounding mode, but applied to the absolute + value of the mpz_t operand. This is not what we want so we put the + high DBL_MANT_DIG bits into a temporary. Starting with GMP 4.2 + (released in March 2006) mpz_get_d now always truncates towards zero. - ENHANCE-ME: The temporary init+clear to force the rounding in gmp 4.1.3 - is a slowdown. It'd be faster to pick out the relevant high bits with - mpz_getlimbn if we could be bothered coding that, and if the new - truncating gmp doesn't come out. */ + ENHANCE-ME: The temporary init+clear to force the rounding in GMP + before 4.2 is a slowdown. It'd be faster to pick out the relevant + high bits with mpz_getlimbn. */ double scm_i_big2dbl (SCM b) @@ -337,7 +336,12 @@ scm_i_big2dbl (SCM b) #if 1 { - /* Current GMP, eg. 4.1.3, force truncation towards zero */ + /* For GMP earlier than 4.2, force truncation towards zero */ + + /* FIXME: DBL_MANT_DIG is the number of base-`FLT_RADIX' digits, + _not_ the number of bits, so this code will break badly on a + system with non-binary doubles. */ + mpz_t tmp; if (bits > DBL_MANT_DIG) { @@ -353,7 +357,7 @@ scm_i_big2dbl (SCM b) } } #else - /* Future GMP */ + /* GMP 4.2 or later */ result = mpz_get_d (SCM_I_BIG_MPZ (b)); #endif From e3c15cf7a61ca79b67f510624cdc1631e3662b20 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Mar 2011 13:46:08 -0500 Subject: [PATCH 089/183] Remove incorrect footnote from GOOPS manual * doc/ref/goops.texi (Inheritance): Remove footnote which incorrectly stated that was not shown in the class hierarchy figure. --- doc/ref/goops.texi | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/doc/ref/goops.texi b/doc/ref/goops.texi index 95e71da82..362a6e371 100644 --- a/doc/ref/goops.texi +++ b/doc/ref/goops.texi @@ -1104,9 +1104,7 @@ Those class definitions define a hierarchy which is shown in @ref{fig:hier}. In this figure, the class @code{} is also shown; this class is the superclass of all Scheme objects. In particular, @code{} is the superclass of all standard Scheme -types.@footnote{@code{}, which is the direct subclass of -@code{} and the direct superclass of @code{}, has been -omitted in this figure.} +types. @float Figure,fig:hier @iftex From 495a39c40f8c31479272495c3a550695077ac335 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 6 Mar 2011 20:27:40 -0500 Subject: [PATCH 090/183] Quotient, remainder and modulo accept inexact integers * libguile/numbers.c (scm_quotient, scm_remainder, scm_modulo): Accept inexact integers as well as exact ones, as required by the R5RS. * test-suite/tests/numbers.test (quotient, remainder, modulo): Add tests. --- libguile/numbers.c | 12 ++++++------ test-suite/tests/numbers.test | 18 ++++++++++++++++++ 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index be86eb575..f8891fa87 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -796,9 +796,9 @@ SCM_PRIMITIVE_GENERIC (scm_quotient, "quotient", 2, 0, 0, "Return the quotient of the numbers @var{x} and @var{y}.") #define FUNC_NAME s_scm_quotient { - if (SCM_LIKELY (SCM_I_INUMP (x)) || SCM_LIKELY (SCM_BIGP (x))) + if (SCM_LIKELY (scm_is_integer (x))) { - if (SCM_LIKELY (SCM_I_INUMP (y)) || SCM_LIKELY (SCM_BIGP (y))) + if (SCM_LIKELY (scm_is_integer (y))) return scm_truncate_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient); @@ -817,9 +817,9 @@ SCM_PRIMITIVE_GENERIC (scm_remainder, "remainder", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_remainder { - if (SCM_LIKELY (SCM_I_INUMP (x)) || SCM_LIKELY (SCM_BIGP (x))) + if (SCM_LIKELY (scm_is_integer (x))) { - if (SCM_LIKELY (SCM_I_INUMP (y)) || SCM_LIKELY (SCM_BIGP (y))) + if (SCM_LIKELY (scm_is_integer (y))) return scm_truncate_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder); @@ -839,9 +839,9 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_modulo { - if (SCM_LIKELY (SCM_I_INUMP (x)) || SCM_LIKELY (SCM_BIGP (x))) + if (SCM_LIKELY (scm_is_integer (x))) { - if (SCM_LIKELY (SCM_I_INUMP (y)) || SCM_LIKELY (SCM_BIGP (y))) + if (SCM_LIKELY (scm_is_integer (y))) return scm_floor_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo); diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index cb582ed1b..95842941d 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -633,6 +633,12 @@ (pass-if "n = fixnum-min - 1" (eqv? 1 (quotient (- fixnum-min 1) (- fixnum-min 1))))) + ;; Inexact integers + + (pass-if (eqv? 5.0 (quotient 35.0 7.0))) + (pass-if (eqv? 5.0 (quotient 35 7.0))) + (pass-if (eqv? 5.0 (quotient 35.0 7 ))) + ;; Positive dividend and divisor (pass-if "35 / 7" @@ -826,6 +832,12 @@ (pass-if "n = fixnum-min - 1" (eqv? 0 (remainder (- fixnum-min 1) (- fixnum-min 1))))) + ;; Inexact integers + + (pass-if (eqv? 2.0 (remainder 37.0 7.0))) + (pass-if (eqv? 2.0 (remainder 37 7.0))) + (pass-if (eqv? 2.0 (remainder 37.0 7 ))) + ;; Positive dividend and divisor (pass-if "35 / 7" @@ -1009,6 +1021,12 @@ (pass-if "n = fixnum-min - 1" (eqv? 0 (modulo (- fixnum-min 1) (- fixnum-min 1))))) + ;; Inexact integers + + (pass-if (eqv? 1.0 (modulo 13.0 4.0))) + (pass-if (eqv? 1.0 (modulo 13 4.0))) + (pass-if (eqv? 1.0 (modulo 13.0 4 ))) + ;; Positive dividend and divisor (pass-if "13 % 4" From ddf134cfec0d82ea9f39ddd69948c08feecb9576 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 4 Mar 2011 13:44:02 -0500 Subject: [PATCH 091/183] Within `while', `continue' takes zero arguments * module/ice-9/boot-9.scm (while): Report an error if `continue' is passed one or more arguments. Previously, it would report an error if `(continue arg rest ...)' was found within the `while', but not if `continue' was found bare and later applied to one or more arguments, e.g. `(apply continue (list arg rest ...))'. --- module/ice-9/boot-9.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 7ca08062f..a0b207cff 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -2803,8 +2803,8 @@ module '(ice-9 q) '(make-q q-length))}." ((_ . args) (syntax-violation 'continue "too many arguments" x)) (_ - #'(lambda args - (apply abort-to-prompt continue-tag args)))))) + #'(lambda () + (abort-to-prompt continue-tag)))))) (do () ((not cond)) body ...)) (lambda (k) (lp))))) (lambda (k) From ce3ce21c623771ecafdf80c98519e80048cfedb7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 8 Mar 2011 13:13:54 -0500 Subject: [PATCH 092/183] Improve docs of string and symbol conversions from C strings * doc/ref/api-data.texi (Conversion to/from C): Document scm_from_latin1_string, scm_from_utf8_string, and scm_from_utf32_string. Remind readers that these functions should be used to convert C string constants, and that scm_from_locale_string is _not_ appropriate for that purpose. (Symbol Primitives): Document scm_from_latin1_symbol and scm_from_utf8_symbol. Remind readers that these functions should be used when the specified names are C string constants, and that scm_from_locale_symbol is _not_ appropriate for that purpose. --- doc/ref/api-data.texi | 32 ++++++++++++++++++++++++++++---- 1 file changed, 28 insertions(+), 4 deletions(-) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 5bef926a9..7fa38d18a 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -4182,6 +4182,12 @@ If @var{len} is @code{(size_t)-1}, then @var{str} does need to be null-terminated and the real length will be found with @code{strlen}. If the C string is ill-formed, an error will be raised. + +Note that these functions should @emph{not} be used to convert C string +constants, because there is no guarantee that the current locale will +match that of the source code. To convert C string constants, use +@code{scm_from_latin1_string}, @code{scm_from_utf8_string} or +@code{scm_from_utf32_string}. @end deftypefn @deftypefn {C Function} SCM scm_take_locale_string (char *str) @@ -4281,10 +4287,16 @@ The @var{handler} parameters suggests a strategy for dealing with unconvertable characters. @end deftypefn -ISO-8859-1 is the most common 8-bit character encoding. This encoding -is also referred to as the Latin-1 encoding. The following two -conversion functions are provided to convert between Latin-1 C strings -and Guile strings. +The following conversion functions are provided as a convenience for the +most commonly used encodings. + +@deftypefn {C Function} SCM scm_from_latin1_string (const char *str) +@deftypefnx {C Function} SCM scm_from_utf8_string (const char *str) +@deftypefnx {C Function} SCM scm_from_utf32_string (const scm_t_wchar *str) +Return a scheme string from the null-terminated C string @var{str}, +which is ISO-8859-1-, UTF-8-, or UTF-32-encoded. These functions should +be used to convert hard-coded C string constants into Scheme strings. +@end deftypefn @deftypefn {C Function} SCM scm_from_latin1_stringn (const char *str, size_t len) @deftypefnx {C Function} SCM scm_from_utf8_stringn (const char *str, size_t len) @@ -5218,12 +5230,24 @@ When you want to do more from C, you should convert between symbols and strings using @code{scm_symbol_to_string} and @code{scm_string_to_symbol} and work with the strings. +@deffn {C Function} scm_from_latin1_symbol (const char *name) +@deffnx {C Function} scm_from_utf8_symbol (const char *name) +Construct and return a Scheme symbol whose name is specified by the +null-terminated C string @var{name}. These are appropriate when +the C string is hard-coded in the source code. +@end deffn + @deffn {C Function} scm_from_locale_symbol (const char *name) @deffnx {C Function} scm_from_locale_symboln (const char *name, size_t len) Construct and return a Scheme symbol whose name is specified by @var{name}. For @code{scm_from_locale_symbol}, @var{name} must be null terminated; for @code{scm_from_locale_symboln} the length of @var{name} is specified explicitly by @var{len}. + +Note that these functions should @emph{not} be used when @var{name} is a +C string constant, because there is no guarantee that the current locale +will match that of the source code. In such cases, use +@code{scm_from_latin1_symbol} or @code{scm_from_utf8_symbol}. @end deffn @deftypefn {C Function} SCM scm_take_locale_symbol (char *str) From c428e58681fbd006d253bda51b3543110b317b8d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 9 Mar 2011 01:14:43 -0500 Subject: [PATCH 093/183] Add scm_from_latin1_keyword and scm_from_utf8_keyword * libguile/keywords.c (scm_from_latin1_keyword, scm_from_utf8_keyword): New functions appropriate for use when keyword name is a constant. (scm_from_locale_keyword, scm_from_locale_keywordn): Change formal parameter from `str' to `name'. * libguile/keywords.h: Add prototypes for new functions. Change formal parameter of scm_from_locale_keyword* from `str' to `name'. * doc/ref/api-data.texi: Document new functions. Remind users that scm_from_locale_keyword should not be used when the name is a C string constant. Change formal parameter from `str' to `name'. --- doc/ref/api-data.texi | 20 ++++++++++++++++---- libguile/keywords.c | 20 ++++++++++++++++---- libguile/keywords.h | 6 ++++-- 3 files changed, 36 insertions(+), 10 deletions(-) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 7fa38d18a..e519cab60 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -5730,11 +5730,23 @@ Return the keyword with the same name as @var{symbol}. Equivalent to @code{scm_is_true (scm_keyword_p (@var{obj}))}. @end deftypefn -@deftypefn {C Function} SCM scm_from_locale_keyword (const char *str) -@deftypefnx {C Function} SCM scm_from_locale_keywordn (const char *str, size_t len) +@deftypefn {C Function} SCM scm_from_locale_keyword (const char *name) +@deftypefnx {C Function} SCM scm_from_locale_keywordn (const char *name, size_t len) Equivalent to @code{scm_symbol_to_keyword (scm_from_locale_symbol -(@var{str}))} and @code{scm_symbol_to_keyword (scm_from_locale_symboln -(@var{str}, @var{len}))}, respectively. +(@var{name}))} and @code{scm_symbol_to_keyword (scm_from_locale_symboln +(@var{name}, @var{len}))}, respectively. + +Note that these functions should @emph{not} be used when @var{name} is a +C string constant, because there is no guarantee that the current locale +will match that of the source code. In such cases, use +@code{scm_from_latin1_keyword} or @code{scm_from_utf8_keyword}. +@end deftypefn + +@deftypefn {C Function} SCM scm_from_latin1_keyword (const char *name) +@deftypefnx {C Function} SCM scm_from_utf8_keyword (const char *name) +Equivalent to @code{scm_symbol_to_keyword (scm_from_latin1_symbol +(@var{name}))} and @code{scm_symbol_to_keyword (scm_from_utf8_symbol +(@var{name}))}, respectively. @end deftypefn @node Other Types diff --git a/libguile/keywords.c b/libguile/keywords.c index 0740801ae..3b9a9228c 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -101,15 +101,27 @@ scm_is_keyword (SCM val) } SCM -scm_from_locale_keyword (const char *str) +scm_from_locale_keyword (const char *name) { - return scm_symbol_to_keyword (scm_from_locale_symbol (str)); + return scm_symbol_to_keyword (scm_from_locale_symbol (name)); } SCM -scm_from_locale_keywordn (const char *str, size_t len) +scm_from_locale_keywordn (const char *name, size_t len) { - return scm_symbol_to_keyword (scm_from_locale_symboln (str, len)); + return scm_symbol_to_keyword (scm_from_locale_symboln (name, len)); +} + +SCM +scm_from_latin1_keyword (const char *name) +{ + return scm_symbol_to_keyword (scm_from_latin1_symbol (name)); +} + +SCM +scm_from_utf8_keyword (const char *name) +{ + return scm_symbol_to_keyword (scm_from_utf8_symbol (name)); } /* njrev: critical sections reviewed so far up to here */ diff --git a/libguile/keywords.h b/libguile/keywords.h index bfffe5923..c9e6af14b 100644 --- a/libguile/keywords.h +++ b/libguile/keywords.h @@ -36,8 +36,10 @@ SCM_API SCM scm_symbol_to_keyword (SCM symbol); SCM_API SCM scm_keyword_to_symbol (SCM keyword); SCM_API int scm_is_keyword (SCM val); -SCM_API SCM scm_from_locale_keyword (const char *str); -SCM_API SCM scm_from_locale_keywordn (const char *str, size_t len); +SCM_API SCM scm_from_locale_keyword (const char *name); +SCM_API SCM scm_from_locale_keywordn (const char *name, size_t len); +SCM_API SCM scm_from_latin1_keyword (const char *name); +SCM_API SCM scm_from_utf8_keyword (const char *name); SCM_INTERNAL void scm_init_keywords (void); From 531c9f1dc51c4801c4d031ee80a31f15285a6b85 Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Wed, 9 Mar 2011 21:36:54 +0100 Subject: [PATCH 094/183] Don't mix definitions and expressions in SRFI-9 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The expansion of `define-inlinable' contained an expression, which made SRFI-9's `define-record-type' fail in non-toplevel contexts ("definition used in expression context"). * module/srfi/srfi-9.scm (define-inlinable): Get rid of apparently useless expression in the expansion, so the expansion yields only definitions. At the same time, use a space in the generated names to lessen the chances of name conflicts, also avoiding -Wunused-toplevel warnings. * test-suite/tests/srfi-9.test (non-toplevel): New test verifying that `define-record-type' works in non-toplevel context as well. * doc/ref/srfi-modules.texi (SRFI-9 - define-record-type): Add subsubsection noting that Guile does not enforce top-levelness. Signed-off-by: Ludovic Courtès --- doc/ref/srfi-modules.texi | 9 ++++++++- module/srfi/srfi-9.scm | 8 +++++--- test-suite/tests/srfi-9.test | 12 +++++++++++- 3 files changed, 24 insertions(+), 5 deletions(-) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index bda7cbb37..eab87794d 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -1927,6 +1927,13 @@ The functions created by @code{define-record-type} are ordinary top-level @code{define}s. They can be redefined or @code{set!} as desired, exported from a module, etc. +@unnumberedsubsubsec Non-toplevel Record Definitions + +The SRFI-9 specification explicitly disallows record definitions in a +non-toplevel context, such as inside @code{lambda} body or inside a +@var{let} block. However, Guile's implementation does not enforce that +restriction. + @unnumberedsubsubsec Custom Printers You may use @code{set-record-type-printer!} to customize the default printing diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm index 80c3b60e8..fad570b26 100644 --- a/module/srfi/srfi-9.scm +++ b/module/srfi/srfi-9.scm @@ -1,6 +1,6 @@ ;;; srfi-9.scm --- define-record-type -;; Copyright (C) 2001, 2002, 2006, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -69,9 +69,12 @@ ;; the macro expansion, whereas references in non-call contexts refer to ;; the procedure. Inspired by the `define-integrable' macro by Dybvig et al. (lambda (x) + ;; Use a space in the prefix to avoid potential -Wunused-toplevel + ;; warning + (define prefix (string->symbol "% ")) (define (make-procedure-name name) (datum->syntax name - (symbol-append '% (syntax->datum name) + (symbol-append prefix (syntax->datum name) '-procedure))) (syntax-case x () @@ -81,7 +84,6 @@ #`(begin (define (proc-name formals ...) body ...) - proc-name ;; unused (define-syntax name (lambda (x) (syntax-case x () diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test index cf933a894..f8006c440 100644 --- a/test-suite/tests/srfi-9.test +++ b/test-suite/tests/srfi-9.test @@ -1,7 +1,7 @@ ;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-05-10 ;;;; -;;;; Copyright (C) 2001, 2006, 2007, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2007, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -93,3 +93,13 @@ ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced (pass-if-exception "set-y! on bar" exception:wrong-type-arg (set-y! b 99))) + +(with-test-prefix "non-toplevel" + + (define-record-type :frotz (make-frotz a b) frotz? + (a frotz-a) (b frotz-b set-frotz-b!)) + + (pass-if "construction" + (let ((frotz (make-frotz 1 2))) + (and (= (frotz-a frotz) 1) + (= (frotz-b frotz) 2))))) From df1297956211b7353155c9b54d7e9c22d05ce493 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 9 Mar 2011 22:37:53 +0100 Subject: [PATCH 095/183] fix-letrec tweaks * module/language/tree-il/fix-letrec.scm (partition-vars): Previously, for letrec* we treated all unreferenced vars as complex, because of orderings of effects that could arise in their definitions. But we can actually keep simple and lambda vars as unreferenced, as their initializers cannot cause side effects. (fix-letrec!): Remove letrec* -> letrec code, as it's unneeded. --- module/language/tree-il/fix-letrec.scm | 149 +++++++++++-------------- 1 file changed, 68 insertions(+), 81 deletions(-) diff --git a/module/language/tree-il/fix-letrec.scm b/module/language/tree-il/fix-letrec.scm index ee8beb2e6..3d7db27a8 100644 --- a/module/language/tree-il/fix-letrec.scm +++ b/module/language/tree-il/fix-letrec.scm @@ -96,9 +96,10 @@ (s '()) (l '()) (c '())) (cond ((null? gensyms) - ;; Unreferenced vars are still complex for letrec*. - ;; We need to update our algorithm to "Fixing letrec - ;; reloaded" to fix this. + ;; Unreferenced complex vars are still + ;; complex for letrec*. We need to update + ;; our algorithm to "Fixing letrec reloaded" + ;; to fix this. (values (if in-order? (lset-difference eq? unref c) unref) @@ -109,7 +110,11 @@ (append c complex))) ((memq (car gensyms) unref) ;; See above note about unref and letrec*. - (if in-order? + (if (and in-order? + (not (lambda? (car vals))) + (not (simple-expression? + (car vals) orig-gensyms + effect+exception-free-primitive?))) (lp (cdr gensyms) (cdr vals) s l (cons (car gensyms) c)) (lp (cdr gensyms) (cdr vals) @@ -190,83 +195,65 @@ x)) (( src in-order? names gensyms vals body) - (if (and in-order? - (every (lambda (x) - (or (lambda? x) - (simple-expression? - x gensyms - effect+exception-free-primitive?))) - vals)) - ;; If it is a `letrec*', return an equivalent `letrec' when - ;; it's possible. This is a hack until we implement the - ;; algorithm described in "Fixing Letrec (Reloaded)" - ;; (Ghuloum and Dybvig) to allow cases such as - ;; (letrec* ((f (lambda () ...))(g (lambda () ...))) ...) - ;; or - ;; (letrec* ((x 2)(y 3)) y) - ;; to be optimized. These can be common when using - ;; internal defines. - (fix-letrec! - (make-letrec src #f names gensyms vals body)) - (let ((binds (map list gensyms names vals))) - ;; The bindings returned by this function need to appear in the same - ;; order that they appear in the letrec. - (define (lookup set) - (let lp ((binds binds)) - (cond - ((null? binds) '()) - ((memq (caar binds) set) - (cons (car binds) (lp (cdr binds)))) - (else (lp (cdr binds)))))) - (let ((u (lookup unref)) - (s (lookup simple)) - (l (lookup lambda*)) - (c (lookup complex))) - ;; Bind "simple" bindings, and locations for complex - ;; bindings. - (make-let - src - (append (map cadr s) (map cadr c)) - (append (map car s) (map car c)) - (append (map caddr s) (map (lambda (x) (make-void #f)) c)) - ;; Bind lambdas using the fixpoint operator. - (make-fix - src (map cadr l) (map car l) (map caddr l) - (make-sequence - src - (append - ;; The right-hand-sides of the unreferenced - ;; bindings, for effect. - (map caddr u) - (cond - ((null? c) - ;; No complex bindings, just emit the body. - (list body)) - (in-order? - ;; For letrec*, assign complex bindings in order, then the - ;; body. - (append - (map (lambda (c) - (make-lexical-set #f (cadr c) (car c) - (caddr c))) - c) - (list body))) - (else - ;; Otherwise for plain letrec, evaluate the the "complex" - ;; bindings, in a `let' to indicate that order doesn't - ;; matter, and bind to their variables. - (list - (let ((tmps (map (lambda (x) (gensym)) c))) - (make-let - #f (map cadr c) tmps (map caddr c) - (make-sequence - #f - (map (lambda (x tmp) - (make-lexical-set - #f (cadr x) (car x) - (make-lexical-ref #f (cadr x) tmp))) - c tmps)))) - body))))))))))) + (let ((binds (map list gensyms names vals))) + ;; The bindings returned by this function need to appear in the same + ;; order that they appear in the letrec. + (define (lookup set) + (let lp ((binds binds)) + (cond + ((null? binds) '()) + ((memq (caar binds) set) + (cons (car binds) (lp (cdr binds)))) + (else (lp (cdr binds)))))) + (let ((u (lookup unref)) + (s (lookup simple)) + (l (lookup lambda*)) + (c (lookup complex))) + ;; Bind "simple" bindings, and locations for complex + ;; bindings. + (make-let + src + (append (map cadr s) (map cadr c)) + (append (map car s) (map car c)) + (append (map caddr s) (map (lambda (x) (make-void #f)) c)) + ;; Bind lambdas using the fixpoint operator. + (make-fix + src (map cadr l) (map car l) (map caddr l) + (make-sequence + src + (append + ;; The right-hand-sides of the unreferenced + ;; bindings, for effect. + (map caddr u) + (cond + ((null? c) + ;; No complex bindings, just emit the body. + (list body)) + (in-order? + ;; For letrec*, assign complex bindings in order, then the + ;; body. + (append + (map (lambda (c) + (make-lexical-set #f (cadr c) (car c) + (caddr c))) + c) + (list body))) + (else + ;; Otherwise for plain letrec, evaluate the the "complex" + ;; bindings, in a `let' to indicate that order doesn't + ;; matter, and bind to their variables. + (list + (let ((tmps (map (lambda (x) (gensym)) c))) + (make-let + #f (map cadr c) tmps (map caddr c) + (make-sequence + #f + (map (lambda (x tmp) + (make-lexical-set + #f (cadr x) (car x) + (make-lexical-ref #f (cadr x) tmp))) + c tmps)))) + body)))))))))) (( src names gensyms vals body) (let ((binds (map list gensyms names vals))) From dd36ce77cd899c7b179026603e751e3bb47b2943 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 7 Mar 2011 06:27:42 -0500 Subject: [PATCH 096/183] Update Gnulib; add new modules; remove `round' module. This updates Gnulib to v0.0-4951-g6ff7b70. * m4/gnulib-cache.m4: Add floor, ceil, frexp, and ldexp. Add wchar as an explicit dependency; it had been present as an indirect dependency before, but no longer. Remove round, which I had requested earlier, but turned out to be unnecessary. --- build-aux/config.rpath | 97 +++++++++++++--------- build-aux/git-version-gen | 31 ++++--- lib/Makefile.am | 58 +++++++++---- lib/ceil.c | 109 +++++++++++++++++++++++++ lib/dosname.h | 53 ++++++++++++ lib/flock.c | 34 ++++---- lib/frexp.c | 166 +++++++++++++++++++++++++++++++++++++ lib/isnand-nolibm.h | 33 ++++++++ lib/round.c | 168 -------------------------------------- lib/stat.c | 1 + lib/stdint.in.h | 7 +- lib/stdio-write.c | 148 --------------------------------- lib/stdlib.in.h | 30 +++++++ lib/vasnprintf.c | 6 +- lib/vasnprintf.h | 14 ++-- lib/version-etc.h | 8 +- libguile/Makefile.am | 4 +- m4/asm-underscore.m4 | 48 ----------- m4/dos.m4 | 71 ---------------- m4/frexp.m4 | 165 +++++++++++++++++++++++++++++++++++++ m4/gnulib-cache.m4 | 8 +- m4/gnulib-comp.m4 | 31 +++++-- m4/ldexp.m4 | 54 ++++++++++++ m4/lib-link.m4 | 4 +- m4/longlong.m4 | 81 +++++++++--------- m4/round.m4 | 111 ------------------------- m4/stat.m4 | 3 +- m4/stdint.m4 | 15 ++-- m4/stdio_h.m4 | 23 +----- m4/stdlib_h.m4 | 6 +- maint.mk | 26 ++++-- 31 files changed, 885 insertions(+), 728 deletions(-) create mode 100644 lib/ceil.c create mode 100644 lib/dosname.h create mode 100644 lib/frexp.c create mode 100644 lib/isnand-nolibm.h delete mode 100644 lib/round.c delete mode 100644 lib/stdio-write.c delete mode 100644 m4/asm-underscore.m4 delete mode 100644 m4/dos.m4 create mode 100644 m4/frexp.m4 create mode 100644 m4/ldexp.m4 delete mode 100644 m4/round.m4 diff --git a/build-aux/config.rpath b/build-aux/config.rpath index 0e87769f9..8bd7f5d72 100755 --- a/build-aux/config.rpath +++ b/build-aux/config.rpath @@ -57,13 +57,6 @@ else aix*) wl='-Wl,' ;; - darwin*) - case $cc_basename in - xlc*) - wl='-Wl,' - ;; - esac - ;; mingw* | cygwin* | pw32* | os2* | cegcc*) ;; hpux9* | hpux10* | hpux11*) @@ -72,9 +65,7 @@ else irix5* | irix6* | nonstopux*) wl='-Wl,' ;; - newsos6) - ;; - linux* | k*bsd*-gnu) + linux* | k*bsd*-gnu | kopensolaris*-gnu) case $cc_basename in ecc*) wl='-Wl,' @@ -85,17 +76,26 @@ else lf95*) wl='-Wl,' ;; - pgcc | pgf77 | pgf90) + nagfor*) + wl='-Wl,-Wl,,' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) wl='-Wl,' ;; ccc*) wl='-Wl,' ;; + xl* | bgxl* | bgf* | mpixl*) + wl='-Wl,' + ;; como) wl='-lopt=' ;; *) case `$CC -V 2>&1 | sed 5q` in + *Sun\ F* | *Sun*Fortran*) + wl= + ;; *Sun\ C*) wl='-Wl,' ;; @@ -103,13 +103,24 @@ else ;; esac ;; + newsos6) + ;; + *nto* | *qnx*) + ;; osf3* | osf4* | osf5*) wl='-Wl,' ;; rdos*) ;; solaris*) - wl='-Wl,' + case $cc_basename in + f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) + wl='-Qoption ld ' + ;; + *) + wl='-Wl,' + ;; + esac ;; sunos4*) wl='-Qoption ld ' @@ -171,15 +182,14 @@ if test "$with_gnu_ld" = yes; then fi ;; amigaos*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - # Samuel A. Falvo II reports - # that the semantics of dynamic libraries on AmigaOS, at least up - # to version 4, is to share data among multiple programs linked - # with the same dynamic library. Since this doesn't match the - # behavior of shared libraries on other platforms, we cannot use - # them. - ld_shlibs=no + case "$host_cpu" in + powerpc) + ;; + m68k) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac ;; beos*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then @@ -198,11 +208,13 @@ if test "$with_gnu_ld" = yes; then ld_shlibs=no fi ;; + haiku*) + ;; interix[3-9]*) hardcode_direct=no hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ;; - gnu* | linux* | k*bsd*-gnu) + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else @@ -325,10 +337,14 @@ else fi ;; amigaos*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - # see comment about different semantics on the GNU ld section - ld_shlibs=no + case "$host_cpu" in + powerpc) + ;; + m68k) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac ;; bsdi[45]*) ;; @@ -342,16 +358,10 @@ else ;; darwin* | rhapsody*) hardcode_direct=no - if test "$GCC" = yes ; then + if { case $cc_basename in ifort*) true;; *) test "$GCC" = yes;; esac; }; then : else - case $cc_basename in - xlc*) - ;; - *) - ld_shlibs=no - ;; - esac + ld_shlibs=no fi ;; dgux*) @@ -417,6 +427,8 @@ else hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: ;; + *nto* | *qnx*) + ;; openbsd*) if test -f /usr/libexec/ld.so; then hardcode_direct=yes @@ -512,7 +524,12 @@ case "$host_os" in library_names_spec='$libname$shrext' ;; amigaos*) - library_names_spec='$libname.a' + case "$host_cpu" in + powerpc*) + library_names_spec='$libname$shrext' ;; + m68k) + library_names_spec='$libname.a' ;; + esac ;; beos*) library_names_spec='$libname$shrext' @@ -542,6 +559,9 @@ case "$host_os" in gnu*) library_names_spec='$libname$shrext' ;; + haiku*) + library_names_spec='$libname$shrext' + ;; hpux9* | hpux10* | hpux11*) case $host_cpu in ia64*) @@ -577,7 +597,7 @@ case "$host_os" in ;; linux*oldld* | linux*aout* | linux*coff*) ;; - linux* | k*bsd*-gnu) + linux* | k*bsd*-gnu | kopensolaris*-gnu) library_names_spec='$libname$shrext' ;; knetbsd*-gnu) @@ -589,7 +609,7 @@ case "$host_os" in newsos6) library_names_spec='$libname$shrext' ;; - nto-qnx*) + *nto* | *qnx*) library_names_spec='$libname$shrext' ;; openbsd*) @@ -620,6 +640,9 @@ case "$host_os" in sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) library_names_spec='$libname$shrext' ;; + tpf*) + library_names_spec='$libname$shrext' + ;; uts4*) library_names_spec='$libname$shrext' ;; diff --git a/build-aux/git-version-gen b/build-aux/git-version-gen index 68c7d6440..686f7031a 100755 --- a/build-aux/git-version-gen +++ b/build-aux/git-version-gen @@ -1,6 +1,6 @@ #!/bin/sh # Print a version string. -scriptversion=2011-01-04.17; # UTC +scriptversion=2011-02-19.19; # UTC # Copyright (C) 2007-2011 Free Software Foundation, Inc. # @@ -80,6 +80,7 @@ nl=' # Avoid meddling by environment variable of the same name. v= +v_from_git= # First see if there is a tarball-only version file. # then try "git describe", then default. @@ -134,24 +135,30 @@ then # Change the first '-' to a '.', so version-comparing tools work properly. # Remove the "g" in git describe's output string, to save a byte. v=`echo "$v" | sed 's/-/./;s/\(.*\)-g/\1-/'`; + v_from_git=1 else v=UNKNOWN fi v=`echo "$v" |sed 's/^v//'` -# Don't declare a version "dirty" merely because a time stamp has changed. -git update-index --refresh > /dev/null 2>&1 +# Test whether to append the "-dirty" suffix only if the version +# string we're using came from git. I.e., skip the test if it's "UNKNOWN" +# or if it came from .tarball-version. +if test -n "$v_from_git"; then + # Don't declare a version "dirty" merely because a time stamp has changed. + git update-index --refresh > /dev/null 2>&1 -dirty=`exec 2>/dev/null;git diff-index --name-only HEAD` || dirty= -case "$dirty" in - '') ;; - *) # Append the suffix only if there isn't one already. - case $v in - *-dirty) ;; - *) v="$v-dirty" ;; - esac ;; -esac + dirty=`exec 2>/dev/null;git diff-index --name-only HEAD` || dirty= + case "$dirty" in + '') ;; + *) # Append the suffix only if there isn't one already. + case $v in + *-dirty) ;; + *) v="$v-dirty" ;; + esac ;; + esac +fi # Omit the trailing newline, so that m4_esyscmd can use the result directly. echo "$v" | tr -d "$nl" diff --git a/lib/Makefile.am b/lib/Makefile.am index 50c374239..5d0c22971 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -9,7 +9,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl close connect duplocale environ extensions flock fpieee full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc putenv recv recvfrom round send sendto setsockopt shutdown socket stat-time stdlib strcase strftime striconveh string sys_stat trunc verify version-etc-fsf vsnprintf warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl ceil close connect duplocale environ extensions flock floor fpieee frexp full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc putenv recv recvfrom send sendto setsockopt shutdown socket stat-time stdlib strcase strftime striconveh string sys_stat trunc verify version-etc-fsf vsnprintf warnings wchar AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects @@ -37,7 +37,9 @@ libgnu_la_DEPENDENCIES = $(gl_LTLIBOBJS) EXTRA_libgnu_la_SOURCES = libgnu_la_LDFLAGS = $(AM_LDFLAGS) libgnu_la_LDFLAGS += -no-undefined +libgnu_la_LDFLAGS += $(CEIL_LIBM) libgnu_la_LDFLAGS += $(FLOOR_LIBM) +libgnu_la_LDFLAGS += $(FREXP_LIBM) libgnu_la_LDFLAGS += $(GETADDRINFO_LIB) libgnu_la_LDFLAGS += $(HOSTENT_LIB) libgnu_la_LDFLAGS += $(INET_NTOP_LIB) @@ -45,12 +47,12 @@ libgnu_la_LDFLAGS += $(INET_PTON_LIB) libgnu_la_LDFLAGS += $(ISNAND_LIBM) libgnu_la_LDFLAGS += $(ISNANF_LIBM) libgnu_la_LDFLAGS += $(ISNANL_LIBM) +libgnu_la_LDFLAGS += $(LDEXP_LIBM) libgnu_la_LDFLAGS += $(LIBSOCKET) libgnu_la_LDFLAGS += $(LOG1P_LIBM) libgnu_la_LDFLAGS += $(LTLIBICONV) libgnu_la_LDFLAGS += $(LTLIBINTL) libgnu_la_LDFLAGS += $(LTLIBUNISTRING) -libgnu_la_LDFLAGS += $(ROUND_LIBM) libgnu_la_LDFLAGS += $(SERVENT_LIB) libgnu_la_LDFLAGS += $(TRUNC_LIBM) @@ -231,6 +233,15 @@ EXTRA_libgnu_la_SOURCES += canonicalize-lgpl.c ## end gnulib module canonicalize-lgpl +## begin gnulib module ceil + + +EXTRA_DIST += ceil.c + +EXTRA_libgnu_la_SOURCES += ceil.c + +## end gnulib module ceil + ## begin gnulib module close @@ -257,6 +268,13 @@ EXTRA_libgnu_la_SOURCES += connect.c ## end gnulib module connect +## begin gnulib module dosname + + +EXTRA_DIST += dosname.h + +## end gnulib module dosname + ## begin gnulib module duplocale @@ -343,6 +361,15 @@ EXTRA_libgnu_la_SOURCES += floor.c ## end gnulib module floor +## begin gnulib module frexp + + +EXTRA_DIST += frexp.c + +EXTRA_libgnu_la_SOURCES += frexp.c + +## end gnulib module frexp + ## begin gnulib module full-read libgnu_la_SOURCES += full-read.h full-read.c @@ -558,6 +585,15 @@ EXTRA_libgnu_la_SOURCES += isnan.c isnand.c ## end gnulib module isnand +## begin gnulib module isnand-nolibm + + +EXTRA_DIST += float+.h isnan.c isnand-nolibm.h isnand.c + +EXTRA_libgnu_la_SOURCES += isnan.c isnand.c + +## end gnulib module isnand-nolibm + ## begin gnulib module isnanf @@ -904,15 +940,6 @@ EXTRA_libgnu_la_SOURCES += recvfrom.c ## end gnulib module recvfrom -## begin gnulib module round - - -EXTRA_DIST += round.c - -EXTRA_libgnu_la_SOURCES += round.c - -## end gnulib module round - ## begin gnulib module safe-read @@ -1097,6 +1124,7 @@ stdint.h: stdint.in.h -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ + -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ @@ -1229,9 +1257,7 @@ stdio.h: stdio.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) mv $@-t $@ MOSTLYCLEANFILES += stdio.h stdio.h-t -EXTRA_DIST += stdio-write.c stdio.in.h - -EXTRA_libgnu_la_SOURCES += stdio-write.c +EXTRA_DIST += stdio.in.h ## end gnulib module stdio @@ -1256,6 +1282,7 @@ stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \ -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \ -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \ + -e 's|@''GNULIB_MBTOWC''@|$(GNULIB_MBTOWC)|g' \ -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \ -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \ -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \ @@ -1274,6 +1301,7 @@ stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \ -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \ -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \ + -e 's|@''GNULIB_WCTOMB''@|$(GNULIB_WCTOMB)|g' \ < $(srcdir)/stdlib.in.h | \ sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \ -e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \ @@ -1302,6 +1330,7 @@ stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) -e 's|@''REPLACE_CALLOC''@|$(REPLACE_CALLOC)|g' \ -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ + -e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \ -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ -e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \ @@ -1309,6 +1338,7 @@ stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) -e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \ -e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \ -e 's|@''REPLACE_UNSETENV''@|$(REPLACE_UNSETENV)|g' \ + -e 's|@''REPLACE_WCTOMB''@|$(REPLACE_WCTOMB)|g' \ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ diff --git a/lib/ceil.c b/lib/ceil.c new file mode 100644 index 000000000..e5367636d --- /dev/null +++ b/lib/ceil.c @@ -0,0 +1,109 @@ +/* Round towards positive infinity. + Copyright (C) 2007, 2010-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +/* Written by Bruno Haible , 2007. */ + +#include + +/* Specification. */ +#include + +#include + +#undef MIN + +#ifdef USE_LONG_DOUBLE +# define FUNC ceill +# define DOUBLE long double +# define MANT_DIG LDBL_MANT_DIG +# define MIN LDBL_MIN +# define L_(literal) literal##L +#elif ! defined USE_FLOAT +# define FUNC ceil +# define DOUBLE double +# define MANT_DIG DBL_MANT_DIG +# define MIN DBL_MIN +# define L_(literal) literal +#else /* defined USE_FLOAT */ +# define FUNC ceilf +# define DOUBLE float +# define MANT_DIG FLT_MANT_DIG +# define MIN FLT_MIN +# define L_(literal) literal##f +#endif + +/* -0.0. See minus-zero.h. */ +#if defined __hpux || defined __sgi || defined __ICC +# define MINUS_ZERO (-MIN * MIN) +#else +# define MINUS_ZERO L_(-0.0) +#endif + +/* 2^(MANT_DIG-1). */ +static const DOUBLE TWO_MANT_DIG = + /* Assume MANT_DIG <= 5 * 31. + Use the identity + n = floor(n/5) + floor((n+1)/5) + ... + floor((n+4)/5). */ + (DOUBLE) (1U << ((MANT_DIG - 1) / 5)) + * (DOUBLE) (1U << ((MANT_DIG - 1 + 1) / 5)) + * (DOUBLE) (1U << ((MANT_DIG - 1 + 2) / 5)) + * (DOUBLE) (1U << ((MANT_DIG - 1 + 3) / 5)) + * (DOUBLE) (1U << ((MANT_DIG - 1 + 4) / 5)); + +DOUBLE +FUNC (DOUBLE x) +{ + /* The use of 'volatile' guarantees that excess precision bits are dropped + at each addition step and before the following comparison at the caller's + site. It is necessary on x86 systems where double-floats are not IEEE + compliant by default, to avoid that the results become platform and compiler + option dependent. 'volatile' is a portable alternative to gcc's + -ffloat-store option. */ + volatile DOUBLE y = x; + volatile DOUBLE z = y; + + if (z > L_(0.0)) + { + /* Avoid rounding errors for values near 2^k, where k >= MANT_DIG-1. */ + if (z < TWO_MANT_DIG) + { + /* Round to the next integer (nearest or up or down, doesn't matter). */ + z += TWO_MANT_DIG; + z -= TWO_MANT_DIG; + /* Enforce rounding up. */ + if (z < y) + z += L_(1.0); + } + } + else if (z < L_(0.0)) + { + /* For -1 < x < 0, return -0.0 regardless of the current rounding + mode. */ + if (z > L_(-1.0)) + z = MINUS_ZERO; + /* Avoid rounding errors for values near -2^k, where k >= MANT_DIG-1. */ + else if (z > - TWO_MANT_DIG) + { + /* Round to the next integer (nearest or up or down, doesn't matter). */ + z -= TWO_MANT_DIG; + z += TWO_MANT_DIG; + /* Enforce rounding up. */ + if (z < y) + z += L_(1.0); + } + } + return z; +} diff --git a/lib/dosname.h b/lib/dosname.h new file mode 100644 index 000000000..3087d39dc --- /dev/null +++ b/lib/dosname.h @@ -0,0 +1,53 @@ +/* File names on MS-DOS/Windows systems. + + Copyright (C) 2000-2001, 2004-2006, 2009-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . + + From Paul Eggert and Jim Meyering. */ + +#ifndef _DOSNAME_H +#define _DOSNAME_H + +#if (defined _WIN32 || defined __WIN32__ || \ + defined __MSDOS__ || defined __CYGWIN__ || \ + defined __EMX__ || defined __DJGPP__) + /* This internal macro assumes ASCII, but all hosts that support drive + letters use ASCII. */ +# define _IS_DRIVE_LETTER(C) (((unsigned int) (C) | ('a' - 'A')) - 'a' \ + <= 'z' - 'a') +# define FILE_SYSTEM_PREFIX_LEN(Filename) \ + (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':' ? 2 : 0) +# ifndef __CYGWIN__ +# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1 +# endif +# define ISSLASH(C) ((C) == '/' || (C) == '\\') +#else +# define FILE_SYSTEM_PREFIX_LEN(Filename) 0 +# define ISSLASH(C) ((C) == '/') +#endif + +#ifndef FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE +# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0 +#endif + +#if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE +# define IS_ABSOLUTE_FILE_NAME(F) ISSLASH ((F)[FILE_SYSTEM_PREFIX_LEN (F)]) +# else +# define IS_ABSOLUTE_FILE_NAME(F) \ + (ISSLASH ((F)[0]) || FILE_SYSTEM_PREFIX_LEN (F) != 0) +#endif +#define IS_RELATIVE_FILE_NAME(F) (! IS_ABSOLUTE_FILE_NAME (F)) + +#endif /* DOSNAME_H_ */ diff --git a/lib/flock.c b/lib/flock.c index bdec6d48e..8f018e50c 100644 --- a/lib/flock.c +++ b/lib/flock.c @@ -27,13 +27,13 @@ #if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ /* _get_osfhandle */ -#include +# include /* LockFileEx */ -#define WIN32_LEAN_AND_MEAN -#include +# define WIN32_LEAN_AND_MEAN +# include -#include +# include /* Determine the current size of a file. Because the other braindead * APIs we'll call need lower/upper 32 bit pairs, keep the file size @@ -47,9 +47,9 @@ file_size (HANDLE h, DWORD * lower, DWORD * upper) } /* LOCKFILE_FAIL_IMMEDIATELY is undefined on some Windows systems. */ -#ifndef LOCKFILE_FAIL_IMMEDIATELY -# define LOCKFILE_FAIL_IMMEDIATELY 1 -#endif +# ifndef LOCKFILE_FAIL_IMMEDIATELY +# define LOCKFILE_FAIL_IMMEDIATELY 1 +# endif /* Acquire a lock. */ static BOOL @@ -160,17 +160,17 @@ flock (int fd, int operation) #else /* !Windows */ -#ifdef HAVE_STRUCT_FLOCK_L_TYPE +# ifdef HAVE_STRUCT_FLOCK_L_TYPE /* We know how to implement flock in terms of fcntl. */ -#include +# include -#ifdef HAVE_UNISTD_H -#include -#endif +# ifdef HAVE_UNISTD_H +# include +# endif -#include -#include +# include +# include int flock (int fd, int operation) @@ -211,10 +211,10 @@ flock (int fd, int operation) return r; } -#else /* !HAVE_STRUCT_FLOCK_L_TYPE */ +# else /* !HAVE_STRUCT_FLOCK_L_TYPE */ -#error "This platform lacks flock function, and Gnulib doesn't provide a replacement. This is a bug in Gnulib." +# error "This platform lacks flock function, and Gnulib doesn't provide a replacement. This is a bug in Gnulib." -#endif /* !HAVE_STRUCT_FLOCK_L_TYPE */ +# endif /* !HAVE_STRUCT_FLOCK_L_TYPE */ #endif /* !Windows */ diff --git a/lib/frexp.c b/lib/frexp.c new file mode 100644 index 000000000..c7687e0df --- /dev/null +++ b/lib/frexp.c @@ -0,0 +1,166 @@ +/* Split a double into fraction and mantissa. + Copyright (C) 2007-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +/* Written by Paolo Bonzini , 2003, and + Bruno Haible , 2007. */ + +#include + +/* Specification. */ +#include + +#include +#ifdef USE_LONG_DOUBLE +# include "isnanl-nolibm.h" +# include "fpucw.h" +#else +# include "isnand-nolibm.h" +#endif + +/* This file assumes FLT_RADIX = 2. If FLT_RADIX is a power of 2 greater + than 2, or not even a power of 2, some rounding errors can occur, so that + then the returned mantissa is only guaranteed to be <= 1.0, not < 1.0. */ + +#ifdef USE_LONG_DOUBLE +# define FUNC frexpl +# define DOUBLE long double +# define ISNAN isnanl +# define DECL_ROUNDING DECL_LONG_DOUBLE_ROUNDING +# define BEGIN_ROUNDING() BEGIN_LONG_DOUBLE_ROUNDING () +# define END_ROUNDING() END_LONG_DOUBLE_ROUNDING () +# define L_(literal) literal##L +#else +# define FUNC frexp +# define DOUBLE double +# define ISNAN isnand +# define DECL_ROUNDING +# define BEGIN_ROUNDING() +# define END_ROUNDING() +# define L_(literal) literal +#endif + +DOUBLE +FUNC (DOUBLE x, int *expptr) +{ + int sign; + int exponent; + DECL_ROUNDING + + /* Test for NaN, infinity, and zero. */ + if (ISNAN (x) || x + x == x) + { + *expptr = 0; + return x; + } + + sign = 0; + if (x < 0) + { + x = - x; + sign = -1; + } + + BEGIN_ROUNDING (); + + { + /* Since the exponent is an 'int', it fits in 64 bits. Therefore the + loops are executed no more than 64 times. */ + DOUBLE pow2[64]; /* pow2[i] = 2^2^i */ + DOUBLE powh[64]; /* powh[i] = 2^-2^i */ + int i; + + exponent = 0; + if (x >= L_(1.0)) + { + /* A positive exponent. */ + DOUBLE pow2_i; /* = pow2[i] */ + DOUBLE powh_i; /* = powh[i] */ + + /* Invariants: pow2_i = 2^2^i, powh_i = 2^-2^i, + x * 2^exponent = argument, x >= 1.0. */ + for (i = 0, pow2_i = L_(2.0), powh_i = L_(0.5); + ; + i++, pow2_i = pow2_i * pow2_i, powh_i = powh_i * powh_i) + { + if (x >= pow2_i) + { + exponent += (1 << i); + x *= powh_i; + } + else + break; + + pow2[i] = pow2_i; + powh[i] = powh_i; + } + /* Avoid making x too small, as it could become a denormalized + number and thus lose precision. */ + while (i > 0 && x < pow2[i - 1]) + { + i--; + powh_i = powh[i]; + } + exponent += (1 << i); + x *= powh_i; + /* Here 2^-2^i <= x < 1.0. */ + } + else + { + /* A negative or zero exponent. */ + DOUBLE pow2_i; /* = pow2[i] */ + DOUBLE powh_i; /* = powh[i] */ + + /* Invariants: pow2_i = 2^2^i, powh_i = 2^-2^i, + x * 2^exponent = argument, x < 1.0. */ + for (i = 0, pow2_i = L_(2.0), powh_i = L_(0.5); + ; + i++, pow2_i = pow2_i * pow2_i, powh_i = powh_i * powh_i) + { + if (x < powh_i) + { + exponent -= (1 << i); + x *= pow2_i; + } + else + break; + + pow2[i] = pow2_i; + powh[i] = powh_i; + } + /* Here 2^-2^i <= x < 1.0. */ + } + + /* Invariants: x * 2^exponent = argument, and 2^-2^i <= x < 1.0. */ + while (i > 0) + { + i--; + if (x < powh[i]) + { + exponent -= (1 << i); + x *= pow2[i]; + } + } + /* Here 0.5 <= x < 1.0. */ + } + + if (sign < 0) + x = - x; + + END_ROUNDING (); + + *expptr = exponent; + return x; +} diff --git a/lib/isnand-nolibm.h b/lib/isnand-nolibm.h new file mode 100644 index 000000000..e434a7bd0 --- /dev/null +++ b/lib/isnand-nolibm.h @@ -0,0 +1,33 @@ +/* Test for NaN that does not need libm. + Copyright (C) 2007-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +#if HAVE_ISNAND_IN_LIBC +/* Get declaration of isnan macro. */ +# include +# if __GNUC__ >= 4 + /* GCC 4.0 and newer provides three built-ins for isnan. */ +# undef isnand +# define isnand(x) __builtin_isnan ((double)(x)) +# else +# undef isnand +# define isnand(x) isnan ((double)(x)) +# endif +#else +/* Test whether X is a NaN. */ +# undef isnand +# define isnand rpl_isnand +extern int isnand (double x); +#endif diff --git a/lib/round.c b/lib/round.c deleted file mode 100644 index 1630a6d79..000000000 --- a/lib/round.c +++ /dev/null @@ -1,168 +0,0 @@ -/* Round toward nearest, breaking ties away from zero. - Copyright (C) 2007, 2010-2011 Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License along - with this program; if not, write to the Free Software Foundation, - Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ - -/* Written by Ben Pfaff , 2007. - Based heavily on code by Bruno Haible. */ - -#include - -/* Specification. */ -#include - -#include - -#undef MIN - -#ifdef USE_LONG_DOUBLE -# define ROUND roundl -# define FLOOR floorl -# define CEIL ceill -# define DOUBLE long double -# define MANT_DIG LDBL_MANT_DIG -# define MIN LDBL_MIN -# define L_(literal) literal##L -# define HAVE_FLOOR_AND_CEIL HAVE_FLOORL_AND_CEILL -#elif ! defined USE_FLOAT -# define ROUND round -# define FLOOR floor -# define CEIL ceil -# define DOUBLE double -# define MANT_DIG DBL_MANT_DIG -# define MIN DBL_MIN -# define L_(literal) literal -# define HAVE_FLOOR_AND_CEIL 1 -#else /* defined USE_FLOAT */ -# define ROUND roundf -# define FLOOR floorf -# define CEIL ceilf -# define DOUBLE float -# define MANT_DIG FLT_MANT_DIG -# define MIN FLT_MIN -# define L_(literal) literal##f -# define HAVE_FLOOR_AND_CEIL HAVE_FLOORF_AND_CEILF -#endif - -/* -0.0. See minus-zero.h. */ -#if defined __hpux || defined __sgi || defined __ICC -# define MINUS_ZERO (-MIN * MIN) -#else -# define MINUS_ZERO L_(-0.0) -#endif - -/* If we're being included from test-round2[f].c, it already defined names for - our round implementations. Otherwise, pick the preferred implementation for - this machine. */ -#if !defined FLOOR_BASED_ROUND && !defined FLOOR_FREE_ROUND -# if HAVE_FLOOR_AND_CEIL -# define FLOOR_BASED_ROUND ROUND -# else -# define FLOOR_FREE_ROUND ROUND -# endif -#endif - -#ifdef FLOOR_BASED_ROUND -/* An implementation of the C99 round function based on floor and ceil. We use - this when floor and ceil are available, on the assumption that they are - faster than the open-coded versions below. */ -DOUBLE -FLOOR_BASED_ROUND (DOUBLE x) -{ - if (x >= L_(0.0)) - { - DOUBLE y = FLOOR (x); - if (x - y >= L_(0.5)) - y += L_(1.0); - return y; - } - else - { - DOUBLE y = CEIL (x); - if (y - x >= L_(0.5)) - y -= L_(1.0); - return y; - } -} -#endif /* FLOOR_BASED_ROUND */ - -#ifdef FLOOR_FREE_ROUND -/* An implementation of the C99 round function without floor or ceil. - We use this when floor or ceil is missing. */ -DOUBLE -FLOOR_FREE_ROUND (DOUBLE x) -{ - /* 2^(MANT_DIG-1). */ - static const DOUBLE TWO_MANT_DIG = - /* Assume MANT_DIG <= 5 * 31. - Use the identity - n = floor(n/5) + floor((n+1)/5) + ... + floor((n+4)/5). */ - (DOUBLE) (1U << ((MANT_DIG - 1) / 5)) - * (DOUBLE) (1U << ((MANT_DIG - 1 + 1) / 5)) - * (DOUBLE) (1U << ((MANT_DIG - 1 + 2) / 5)) - * (DOUBLE) (1U << ((MANT_DIG - 1 + 3) / 5)) - * (DOUBLE) (1U << ((MANT_DIG - 1 + 4) / 5)); - - /* The use of 'volatile' guarantees that excess precision bits are dropped at - each addition step and before the following comparison at the caller's - site. It is necessary on x86 systems where double-floats are not IEEE - compliant by default, to avoid that the results become platform and - compiler option dependent. 'volatile' is a portable alternative to gcc's - -ffloat-store option. */ - volatile DOUBLE y = x; - volatile DOUBLE z = y; - - if (z > L_(0.0)) - { - /* Avoid rounding error for x = 0.5 - 2^(-MANT_DIG-1). */ - if (z < L_(0.5)) - z = L_(0.0); - /* Avoid rounding errors for values near 2^k, where k >= MANT_DIG-1. */ - else if (z < TWO_MANT_DIG) - { - /* Add 0.5 to the absolute value. */ - y = z += L_(0.5); - /* Round to the next integer (nearest or up or down, doesn't - matter). */ - z += TWO_MANT_DIG; - z -= TWO_MANT_DIG; - /* Enforce rounding down. */ - if (z > y) - z -= L_(1.0); - } - } - else if (z < L_(0.0)) - { - /* Avoid rounding error for x = -(0.5 - 2^(-MANT_DIG-1)). */ - if (z > - L_(0.5)) - z = MINUS_ZERO; - /* Avoid rounding errors for values near -2^k, where k >= MANT_DIG-1. */ - else if (z > -TWO_MANT_DIG) - { - /* Add 0.5 to the absolute value. */ - y = z -= L_(0.5); - /* Round to the next integer (nearest or up or down, doesn't - matter). */ - z -= TWO_MANT_DIG; - z += TWO_MANT_DIG; - /* Enforce rounding up. */ - if (z < y) - z += L_(1.0); - } - } - return z; -} -#endif /* FLOOR_FREE_ROUND */ - diff --git a/lib/stat.c b/lib/stat.c index d154a18b0..aa369d0f2 100644 --- a/lib/stat.c +++ b/lib/stat.c @@ -37,6 +37,7 @@ orig_stat (const char *filename, struct stat *buf) #include #include #include +#include "dosname.h" /* Store information about NAME into ST. Work around bugs with trailing slashes. Mingw has other bugs (such as st_ino always diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 319b8aa15..b60e9cc0b 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -497,7 +497,12 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t) sequence of nested includes -> -> -> , and the latter includes and assumes its types are already defined. */ -#if ! (defined WCHAR_MIN && defined WCHAR_MAX) +#if @HAVE_WCHAR_H@ && ! (defined WCHAR_MIN && defined WCHAR_MAX) + /* BSD/OS 4.0.1 has a bug: , and must be + included before . */ +# include +# include +# include # define _GL_JUST_INCLUDE_SYSTEM_WCHAR_H # include # undef _GL_JUST_INCLUDE_SYSTEM_WCHAR_H diff --git a/lib/stdio-write.c b/lib/stdio-write.c deleted file mode 100644 index 252d9bce8..000000000 --- a/lib/stdio-write.c +++ /dev/null @@ -1,148 +0,0 @@ -/* POSIX compatible FILE stream write function. - Copyright (C) 2008-2011 Free Software Foundation, Inc. - Written by Bruno Haible , 2008. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation; either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . */ - -#include - -/* Specification. */ -#include - -/* Replace these functions only if module 'sigpipe' is requested. */ -#if GNULIB_SIGPIPE - -/* On native Windows platforms, SIGPIPE does not exist. When write() is - called on a pipe with no readers, WriteFile() fails with error - GetLastError() = ERROR_NO_DATA, and write() in consequence fails with - error EINVAL. This write() function is at the basis of the function - which flushes the buffer of a FILE stream. */ - -# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ - -# include -# include -# include - -# define WIN32_LEAN_AND_MEAN /* avoid including junk */ -# include - -# define CALL_WITH_SIGPIPE_EMULATION(RETTYPE, EXPRESSION, FAILED) \ - if (ferror (stream)) \ - return (EXPRESSION); \ - else \ - { \ - RETTYPE ret; \ - SetLastError (0); \ - ret = (EXPRESSION); \ - if (FAILED && GetLastError () == ERROR_NO_DATA && ferror (stream)) \ - { \ - int fd = fileno (stream); \ - if (fd >= 0 \ - && GetFileType ((HANDLE) _get_osfhandle (fd)) == FILE_TYPE_PIPE)\ - { \ - /* Try to raise signal SIGPIPE. */ \ - raise (SIGPIPE); \ - /* If it is currently blocked or ignored, change errno from \ - EINVAL to EPIPE. */ \ - errno = EPIPE; \ - } \ - } \ - return ret; \ - } - -# if !REPLACE_PRINTF_POSIX /* avoid collision with printf.c */ -int -printf (const char *format, ...) -{ - int retval; - va_list args; - - va_start (args, format); - retval = vfprintf (stdout, format, args); - va_end (args); - - return retval; -} -# endif - -# if !REPLACE_FPRINTF_POSIX /* avoid collision with fprintf.c */ -int -fprintf (FILE *stream, const char *format, ...) -{ - int retval; - va_list args; - - va_start (args, format); - retval = vfprintf (stream, format, args); - va_end (args); - - return retval; -} -# endif - -# if !REPLACE_VPRINTF_POSIX /* avoid collision with vprintf.c */ -int -vprintf (const char *format, va_list args) -{ - return vfprintf (stdout, format, args); -} -# endif - -# if !REPLACE_VFPRINTF_POSIX /* avoid collision with vfprintf.c */ -int -vfprintf (FILE *stream, const char *format, va_list args) -#undef vfprintf -{ - CALL_WITH_SIGPIPE_EMULATION (int, vfprintf (stream, format, args), ret == EOF) -} -# endif - -int -putchar (int c) -{ - return fputc (c, stdout); -} - -int -fputc (int c, FILE *stream) -#undef fputc -{ - CALL_WITH_SIGPIPE_EMULATION (int, fputc (c, stream), ret == EOF) -} - -int -fputs (const char *string, FILE *stream) -#undef fputs -{ - CALL_WITH_SIGPIPE_EMULATION (int, fputs (string, stream), ret == EOF) -} - -int -puts (const char *string) -#undef puts -{ - FILE *stream = stdout; - CALL_WITH_SIGPIPE_EMULATION (int, puts (string), ret == EOF) -} - -size_t -fwrite (const void *ptr, size_t s, size_t n, FILE *stream) -#undef fwrite -{ - CALL_WITH_SIGPIPE_EMULATION (size_t, fwrite (ptr, s, n, stream), ret < n) -} - -# endif -#endif diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index e2d945767..980b909af 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -274,6 +274,21 @@ _GL_WARN_ON_USE (malloc, "malloc is not POSIX compliant everywhere - " "use gnulib module malloc-posix for portability"); #endif +/* Convert a multibyte character to a wide character. */ +#if @GNULIB_MBTOWC@ +# if @REPLACE_MBTOWC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mbtowc +# define mbtowc rpl_mbtowc +# endif +_GL_FUNCDECL_RPL (mbtowc, int, (wchar_t *pwc, const char *s, size_t n)); +_GL_CXXALIAS_RPL (mbtowc, int, (wchar_t *pwc, const char *s, size_t n)); +# else +_GL_CXXALIAS_SYS (mbtowc, int, (wchar_t *pwc, const char *s, size_t n)); +# endif +_GL_CXXALIASWARN (mbtowc); +#endif + #if @GNULIB_MKDTEMP@ /* Create a unique temporary directory from TEMPLATE. The last six characters of TEMPLATE must be "XXXXXX"; @@ -723,6 +738,21 @@ _GL_WARN_ON_USE (unsetenv, "unsetenv is unportable - " # endif #endif +/* Convert a wide character to a multibyte character. */ +#if @GNULIB_WCTOMB@ +# if @REPLACE_WCTOMB@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef wctomb +# define wctomb rpl_wctomb +# endif +_GL_FUNCDECL_RPL (wctomb, int, (char *s, wchar_t wc)); +_GL_CXXALIAS_RPL (wctomb, int, (char *s, wchar_t wc)); +# else +_GL_CXXALIAS_SYS (wctomb, int, (char *s, wchar_t wc)); +# endif +_GL_CXXALIASWARN (wctomb); +#endif + #endif /* _GL_STDLIB_H */ #endif /* _GL_STDLIB_H */ diff --git a/lib/vasnprintf.c b/lib/vasnprintf.c index cad862f9d..fec68c825 100644 --- a/lib/vasnprintf.c +++ b/lib/vasnprintf.c @@ -935,11 +935,11 @@ decode_long_double (long double x, int *ep, mpn_t *mp) abort (); m.limbs[--i] = (hi << (GMP_LIMB_BITS / 2)) | lo; } -#if 0 /* On FreeBSD 6.1/x86, 'long double' numbers sometimes have excess - precision. */ +# if 0 /* On FreeBSD 6.1/x86, 'long double' numbers sometimes have excess + precision. */ if (!(y == 0.0L)) abort (); -#endif +# endif /* Normalise. */ while (m.nlimbs > 0 && m.limbs[m.nlimbs - 1] == 0) m.nlimbs--; diff --git a/lib/vasnprintf.h b/lib/vasnprintf.h index 7ae03da8e..e2de468aa 100644 --- a/lib/vasnprintf.h +++ b/lib/vasnprintf.h @@ -24,16 +24,16 @@ /* Get size_t. */ #include -#ifndef __attribute__ /* The __attribute__ feature is available in gcc versions 2.5 and later. The __-protected variants of the attributes 'format' and 'printf' are accepted by gcc versions 2.6.4 (effectively 2.7) and later. - We enable __attribute__ only if these are supported too, because + We enable _GL_ATTRIBUTE_FORMAT only if these are supported too, because gnulib and libintl do '#define printf __printf__' when they override the 'printf' function. */ -# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 7) -# define __attribute__(Spec) /* empty */ -# endif +#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) +# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) +#else +# define _GL_ATTRIBUTE_FORMAT(spec) /* empty */ #endif #ifdef __cplusplus @@ -69,9 +69,9 @@ extern "C" { # define vasnprintf rpl_vasnprintf #endif extern char * asnprintf (char *resultbuf, size_t *lengthp, const char *format, ...) - __attribute__ ((__format__ (__printf__, 3, 4))); + _GL_ATTRIBUTE_FORMAT ((__printf__, 3, 4)); extern char * vasnprintf (char *resultbuf, size_t *lengthp, const char *format, va_list args) - __attribute__ ((__format__ (__printf__, 3, 0))); + _GL_ATTRIBUTE_FORMAT ((__printf__, 3, 0)); #ifdef __cplusplus } diff --git a/lib/version-etc.h b/lib/version-etc.h index 9446dec14..b197ad11f 100644 --- a/lib/version-etc.h +++ b/lib/version-etc.h @@ -23,11 +23,11 @@ # include /* The `sentinel' attribute was added in gcc 4.0. */ -#ifndef ATTRIBUTE_SENTINEL +#ifndef _GL_ATTRIBUTE_SENTINEL # if 4 <= __GNUC__ -# define ATTRIBUTE_SENTINEL __attribute__ ((__sentinel__)) +# define _GL_ATTRIBUTE_SENTINEL __attribute__ ((__sentinel__)) # else -# define ATTRIBUTE_SENTINEL /* empty */ +# define _GL_ATTRIBUTE_SENTINEL /* empty */ # endif #endif @@ -70,7 +70,7 @@ extern void version_etc (FILE *stream, const char *command_name, const char *package, const char *version, /* const char *author1, ..., NULL */ ...) - ATTRIBUTE_SENTINEL; + _GL_ATTRIBUTE_SENTINEL; /* Display the usual `Report bugs to' stanza */ extern void emit_bug_reporting_address (void); diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 20c179520..ac27eb8fb 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -460,7 +460,9 @@ version_info = @LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGU libguile_@GUILE_EFFECTIVE_VERSION@_la_LDFLAGS = \ $(BDW_GC_LIBS) $(LIBFFI_LIBS) \ + $(CEIL_LIBM) \ $(FLOOR_LIBM) \ + $(FREXP_LIBM) \ $(GETADDRINFO_LIB) \ $(HOSTENT_LIB) \ $(INET_NTOP_LIB) \ @@ -468,12 +470,12 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_LDFLAGS = \ $(ISNAND_LIBM) \ $(ISNANF_LIBM) \ $(ISNANL_LIBM) \ + $(LDEXP_LIBM) \ $(LIBSOCKET) \ $(LOG1P_LIBM) \ $(LTLIBICONV) \ $(LTLIBINTL) \ $(LTLIBUNISTRING) \ - $(ROUND_LIBM) \ $(SERVENT_LIB) \ $(TRUNC_LIBM) \ -version-info $(version_info) \ diff --git a/m4/asm-underscore.m4 b/m4/asm-underscore.m4 deleted file mode 100644 index 15c89cca9..000000000 --- a/m4/asm-underscore.m4 +++ /dev/null @@ -1,48 +0,0 @@ -# asm-underscore.m4 serial 1 -dnl Copyright (C) 2010-2011 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Bruno Haible. Based on as-underscore.m4 in GNU clisp. - -# gl_ASM_SYMBOL_PREFIX -# Tests for the prefix of C symbols at the assembly language level and the -# linker level. This prefix is either an underscore or empty. Defines the -# C macro USER_LABEL_PREFIX to this prefix, and sets ASM_SYMBOL_PREFIX to -# a stringified variant of this prefix. - -AC_DEFUN([gl_ASM_SYMBOL_PREFIX], -[ - dnl We don't use GCC's __USER_LABEL_PREFIX__ here, because - dnl 1. It works only for GCC. - dnl 2. It is incorrectly defined on some platforms, in some GCC versions. - AC_CACHE_CHECK( - [whether C symbols are prefixed with underscore at the linker level], - [gl_cv_prog_as_underscore], - [cat > conftest.c </dev/null 2>&1 - if grep _foo conftest.s >/dev/null ; then - gl_cv_prog_as_underscore=yes - else - gl_cv_prog_as_underscore=no - fi - rm -f conftest* - ]) - if test $gl_cv_prog_as_underscore = yes; then - USER_LABEL_PREFIX=_ - else - USER_LABEL_PREFIX= - fi - AC_DEFINE_UNQUOTED([USER_LABEL_PREFIX], [$USER_LABEL_PREFIX], - [Define to the prefix of C symbols at the assembler and linker level, - either an underscore or empty.]) - ASM_SYMBOL_PREFIX='"'${USER_LABEL_PREFIX}'"' - AC_SUBST([ASM_SYMBOL_PREFIX]) -]) diff --git a/m4/dos.m4 b/m4/dos.m4 deleted file mode 100644 index ed9c4cee6..000000000 --- a/m4/dos.m4 +++ /dev/null @@ -1,71 +0,0 @@ -#serial 11 -*- autoconf -*- - -# Define some macros required for proper operation of code in lib/*.c -# on MSDOS/Windows systems. - -# Copyright (C) 2000-2001, 2004-2006, 2009-2011 Free Software Foundation, Inc. -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# From Jim Meyering. - -AC_DEFUN([gl_AC_DOS], - [ - AC_CACHE_CHECK([whether system is Windows or MSDOS], [ac_cv_win_or_dos], - [ - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[ -#if !defined _WIN32 && !defined __WIN32__ && !defined __MSDOS__ && !defined __CYGWIN__ -neither MSDOS nor Windows -#endif]])], - [ac_cv_win_or_dos=yes], - [ac_cv_win_or_dos=no]) - ]) - - if test x"$ac_cv_win_or_dos" = xyes; then - ac_fs_accepts_drive_letter_prefix=1 - ac_fs_backslash_is_file_name_separator=1 - AC_CACHE_CHECK([whether drive letter can start relative path], - [ac_cv_drive_letter_can_be_relative], - [ - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[ -#if defined __CYGWIN__ -drive letters are always absolute -#endif]])], - [ac_cv_drive_letter_can_be_relative=yes], - [ac_cv_drive_letter_can_be_relative=no]) - ]) - if test x"$ac_cv_drive_letter_can_be_relative" = xyes; then - ac_fs_drive_letter_can_be_relative=1 - else - ac_fs_drive_letter_can_be_relative=0 - fi - else - ac_fs_accepts_drive_letter_prefix=0 - ac_fs_backslash_is_file_name_separator=0 - ac_fs_drive_letter_can_be_relative=0 - fi - - AC_DEFINE_UNQUOTED([FILE_SYSTEM_ACCEPTS_DRIVE_LETTER_PREFIX], - $ac_fs_accepts_drive_letter_prefix, - [Define on systems for which file names may have a so-called - `drive letter' prefix, define this to compute the length of that - prefix, including the colon.]) - - AH_VERBATIM(ISSLASH, - [#if FILE_SYSTEM_BACKSLASH_IS_FILE_NAME_SEPARATOR -# define ISSLASH(C) ((C) == '/' || (C) == '\\') -#else -# define ISSLASH(C) ((C) == '/') -#endif]) - - AC_DEFINE_UNQUOTED([FILE_SYSTEM_BACKSLASH_IS_FILE_NAME_SEPARATOR], - $ac_fs_backslash_is_file_name_separator, - [Define if the backslash character may also serve as a file name - component separator.]) - - AC_DEFINE_UNQUOTED([FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE], - $ac_fs_drive_letter_can_be_relative, - [Define if a drive letter prefix denotes a relative path if it is - not followed by a file name component separator.]) - ]) diff --git a/m4/frexp.m4 b/m4/frexp.m4 new file mode 100644 index 000000000..2e0fb3b47 --- /dev/null +++ b/m4/frexp.m4 @@ -0,0 +1,165 @@ +# frexp.m4 serial 10 +dnl Copyright (C) 2007-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_FREXP], +[ + AC_REQUIRE([gl_MATH_H_DEFAULTS]) + AC_REQUIRE([gl_CHECK_FREXP_NO_LIBM]) + FREXP_LIBM= + if test $gl_cv_func_frexp_no_libm = no; then + AC_CACHE_CHECK([whether frexp() can be used with libm], + [gl_cv_func_frexp_in_libm], + [ + save_LIBS="$LIBS" + LIBS="$LIBS -lm" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + double x;]], + [[int e; return frexp (x, &e) > 0;]])], + [gl_cv_func_frexp_in_libm=yes], + [gl_cv_func_frexp_in_libm=no]) + LIBS="$save_LIBS" + ]) + if test $gl_cv_func_frexp_in_libm = yes; then + FREXP_LIBM=-lm + fi + fi + if test $gl_cv_func_frexp_no_libm = yes \ + || test $gl_cv_func_frexp_in_libm = yes; then + save_LIBS="$LIBS" + LIBS="$LIBS $FREXP_LIBM" + gl_FUNC_FREXP_WORKS + LIBS="$save_LIBS" + case "$gl_cv_func_frexp_works" in + *yes) gl_func_frexp=yes ;; + *) gl_func_frexp=no; REPLACE_FREXP=1; FREXP_LIBM= ;; + esac + else + gl_func_frexp=no + fi + if test $gl_func_frexp = yes; then + AC_DEFINE([HAVE_FREXP], [1], + [Define if the frexp() function is available and works.]) + else + AC_LIBOBJ([frexp]) + fi + AC_SUBST([FREXP_LIBM]) +]) + +AC_DEFUN([gl_FUNC_FREXP_NO_LIBM], +[ + AC_REQUIRE([gl_MATH_H_DEFAULTS]) + AC_REQUIRE([gl_CHECK_FREXP_NO_LIBM]) + if test $gl_cv_func_frexp_no_libm = yes; then + gl_FUNC_FREXP_WORKS + case "$gl_cv_func_frexp_works" in + *yes) gl_func_frexp_no_libm=yes ;; + *) gl_func_frexp_no_libm=no; REPLACE_FREXP=1 ;; + esac + else + gl_func_frexp_no_libm=no + dnl Set REPLACE_FREXP here because the system may have frexp in libm. + REPLACE_FREXP=1 + fi + if test $gl_func_frexp_no_libm = yes; then + AC_DEFINE([HAVE_FREXP_IN_LIBC], [1], + [Define if the frexp() function is available in libc.]) + else + AC_LIBOBJ([frexp]) + fi +]) + +dnl Test whether frexp() can be used without linking with libm. +dnl Set gl_cv_func_frexp_no_libm to 'yes' or 'no' accordingly. +AC_DEFUN([gl_CHECK_FREXP_NO_LIBM], +[ + AC_CACHE_CHECK([whether frexp() can be used without linking with libm], + [gl_cv_func_frexp_no_libm], + [ + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + double x;]], + [[int e; return frexp (x, &e) > 0;]])], + [gl_cv_func_frexp_no_libm=yes], + [gl_cv_func_frexp_no_libm=no]) + ]) +]) + +dnl Test whether frexp() works also on denormalized numbers (this fails e.g. on +dnl NetBSD 3.0), on infinite numbers (this fails e.g. on IRIX 6.5 and mingw), +dnl and on negative zero (this fails e.g. on NetBSD 4.99). +AC_DEFUN([gl_FUNC_FREXP_WORKS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles + AC_CACHE_CHECK([whether frexp works], [gl_cv_func_frexp_works], + [ + AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ +#include +#include +#include +/* HP cc on HP-UX 10.20 has a bug with the constant expression -0.0. + ICC 10.0 has a bug when optimizing the expression -zero. + The expression -DBL_MIN * DBL_MIN does not work when cross-compiling + to PowerPC on MacOS X 10.5. */ +#if defined __hpux || defined __sgi || defined __ICC +static double +compute_minus_zero (void) +{ + return -DBL_MIN * DBL_MIN; +} +# define minus_zero compute_minus_zero () +#else +double minus_zero = -0.0; +#endif +int main() +{ + int result = 0; + int i; + volatile double x; + double zero = 0.0; + /* Test on denormalized numbers. */ + for (i = 1, x = 1.0; i >= DBL_MIN_EXP; i--, x *= 0.5) + ; + if (x > 0.0) + { + int exp; + double y = frexp (x, &exp); + /* On machines with IEEE754 arithmetic: x = 1.11254e-308, exp = -1022. + On NetBSD: y = 0.75. Correct: y = 0.5. */ + if (y != 0.5) + result |= 1; + } + /* Test on infinite numbers. */ + x = 1.0 / 0.0; + { + int exp; + double y = frexp (x, &exp); + if (y != x) + result |= 2; + } + /* Test on negative zero. */ + x = minus_zero; + { + int exp; + double y = frexp (x, &exp); + if (memcmp (&y, &x, sizeof x)) + result |= 4; + } + return result; +}]])], + [gl_cv_func_frexp_works=yes], + [gl_cv_func_frexp_works=no], + [case "$host_os" in + netbsd* | irix* | mingw*) gl_cv_func_frexp_works="guessing no";; + *) gl_cv_func_frexp_works="guessing yes";; + esac + ]) + ]) +]) diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4 index 63d329358..2d84c7f24 100644 --- a/m4/gnulib-cache.m4 +++ b/m4/gnulib-cache.m4 @@ -15,7 +15,7 @@ # Specification in the form of a command-line invocation: -# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl close connect duplocale environ extensions flock fpieee full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc putenv recv recvfrom round send sendto setsockopt shutdown socket stat-time stdlib strcase strftime striconveh string sys_stat trunc verify version-etc-fsf vsnprintf warnings +# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl ceil close connect duplocale environ extensions flock floor fpieee frexp full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc putenv recv recvfrom send sendto setsockopt shutdown socket stat-time stdlib strcase strftime striconveh string sys_stat trunc verify version-etc-fsf vsnprintf warnings wchar # Specification in the form of a few gnulib-tool.m4 macro invocations: gl_LOCAL_DIR([]) @@ -28,13 +28,16 @@ gl_MODULES([ bind byteswap canonicalize-lgpl + ceil close connect duplocale environ extensions flock + floor fpieee + frexp full-read full-write func @@ -53,6 +56,7 @@ gl_MODULES([ inet_pton isinf isnan + ldexp lib-symbol-versions lib-symbol-visibility libunistring @@ -66,7 +70,6 @@ gl_MODULES([ putenv recv recvfrom - round send sendto setsockopt @@ -84,6 +87,7 @@ gl_MODULES([ version-etc-fsf vsnprintf warnings + wchar ]) gl_AVOID([]) gl_SOURCE_BASE([lib]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index a64693b3a..8a70734a3 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -42,9 +42,11 @@ AC_DEFUN([gl_EARLY], # Code from module c-strcase: # Code from module c-strcaseeq: # Code from module canonicalize-lgpl: + # Code from module ceil: # Code from module close: # Code from module close-hook: # Code from module connect: + # Code from module dosname: # Code from module duplocale: # Code from module environ: # Code from module errno: @@ -56,6 +58,7 @@ AC_DEFUN([gl_EARLY], # Code from module floor: # Code from module fpieee: AC_REQUIRE([gl_FP_IEEE]) + # Code from module frexp: # Code from module full-read: # Code from module full-write: # Code from module func: @@ -84,8 +87,10 @@ AC_DEFUN([gl_EARLY], # Code from module isinf: # Code from module isnan: # Code from module isnand: + # Code from module isnand-nolibm: # Code from module isnanf: # Code from module isnanl: + # Code from module ldexp: # Code from module lib-symbol-versions: # Code from module lib-symbol-visibility: # Code from module libunistring: @@ -108,7 +113,6 @@ AC_DEFUN([gl_EARLY], # Code from module readlink: # Code from module recv: # Code from module recvfrom: - # Code from module round: # Code from module safe-read: # Code from module safe-write: # Code from module send: @@ -217,6 +221,9 @@ AC_DEFUN([gl_INIT], gl_MODULE_INDICATOR([canonicalize-lgpl]) gl_STDLIB_MODULE_INDICATOR([canonicalize_file_name]) gl_STDLIB_MODULE_INDICATOR([realpath]) + # Code from module ceil: + gl_FUNC_CEIL + gl_MATH_MODULE_INDICATOR([ceil]) # Code from module close: gl_FUNC_CLOSE gl_UNISTD_MODULE_INDICATOR([close]) @@ -227,6 +234,7 @@ AC_DEFUN([gl_INIT], AC_LIBOBJ([connect]) fi gl_SYS_SOCKET_MODULE_INDICATOR([connect]) + # Code from module dosname: # Code from module duplocale: gl_FUNC_DUPLOCALE gl_LOCALE_MODULE_INDICATOR([duplocale]) @@ -248,6 +256,9 @@ AC_DEFUN([gl_INIT], gl_FUNC_FLOOR gl_MATH_MODULE_INDICATOR([floor]) # Code from module fpieee: + # Code from module frexp: + gl_FUNC_FREXP + gl_MATH_MODULE_INDICATOR([frexp]) # Code from module full-read: # Code from module full-write: # Code from module func: @@ -324,12 +335,16 @@ AC_DEFUN([gl_INIT], # Code from module isnand: gl_FUNC_ISNAND gl_MATH_MODULE_INDICATOR([isnand]) + # Code from module isnand-nolibm: + gl_FUNC_ISNAND_NO_LIBM # Code from module isnanf: gl_FUNC_ISNANF gl_MATH_MODULE_INDICATOR([isnanf]) # Code from module isnanl: gl_FUNC_ISNANL gl_MATH_MODULE_INDICATOR([isnanl]) + # Code from module ldexp: + gl_FUNC_LDEXP # Code from module lib-symbol-versions: gl_LD_VERSION_SCRIPT # Code from module lib-symbol-visibility: @@ -394,9 +409,6 @@ AC_DEFUN([gl_INIT], AC_LIBOBJ([recvfrom]) fi gl_SYS_SOCKET_MODULE_INDICATOR([recvfrom]) - # Code from module round: - gl_FUNC_ROUND - gl_MATH_MODULE_INDICATOR([round]) # Code from module safe-read: gl_SAFE_READ # Code from module safe-write: @@ -713,10 +725,12 @@ AC_DEFUN([gl_FILE_LIST], [ lib/c-strcaseeq.h lib/c-strncasecmp.c lib/canonicalize-lgpl.c + lib/ceil.c lib/close-hook.c lib/close-hook.h lib/close.c lib/connect.c + lib/dosname.h lib/duplocale.c lib/errno.in.h lib/fclose.c @@ -724,6 +738,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/float.in.h lib/flock.c lib/floor.c + lib/frexp.c lib/full-read.c lib/full-read.h lib/full-write.c @@ -748,6 +763,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/inet_pton.c lib/isinf.c lib/isnan.c + lib/isnand-nolibm.h lib/isnand.c lib/isnanf.c lib/isnanl.c @@ -775,7 +791,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/readlink.c lib/recv.c lib/recvfrom.c - lib/round.c lib/safe-read.c lib/safe-read.h lib/safe-write.c @@ -795,7 +810,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stdbool.in.h lib/stddef.in.h lib/stdint.in.h - lib/stdio-write.c lib/stdio.in.h lib/stdlib.in.h lib/strcasecmp.c @@ -839,14 +853,12 @@ AC_DEFUN([gl_FILE_LIST], [ m4/absolute-header.m4 m4/alloca.m4 m4/arpa_inet_h.m4 - m4/asm-underscore.m4 m4/autobuild.m4 m4/byteswap.m4 m4/canonicalize.m4 m4/ceil.m4 m4/check-math-lib.m4 m4/close.m4 - m4/dos.m4 m4/double-slash-root.m4 m4/duplocale.m4 m4/eealloc.m4 @@ -861,6 +873,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/flock.m4 m4/floor.m4 m4/fpieee.m4 + m4/frexp.m4 m4/func.m4 m4/getaddrinfo.m4 m4/gnulib-common.m4 @@ -880,6 +893,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/isnanf.m4 m4/isnanl.m4 m4/ld-version-script.m4 + m4/ldexp.m4 m4/lib-ld.m4 m4/lib-link.m4 m4/lib-prefix.m4 @@ -902,7 +916,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/printf.m4 m4/putenv.m4 m4/readlink.m4 - m4/round.m4 m4/safe-read.m4 m4/safe-write.m4 m4/servent.m4 diff --git a/m4/ldexp.m4 b/m4/ldexp.m4 new file mode 100644 index 000000000..dd400d469 --- /dev/null +++ b/m4/ldexp.m4 @@ -0,0 +1,54 @@ +# ldexp.m4 serial 1 +dnl Copyright (C) 2010-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_LDEXP], +[ + AC_REQUIRE([gl_CHECK_LDEXP_NO_LIBM]) + LDEXP_LIBM= + if test $gl_cv_func_ldexp_no_libm = no; then + AC_CACHE_CHECK([whether ldexp() can be used with libm], + [gl_cv_func_ldexp_in_libm], + [ + save_LIBS="$LIBS" + LIBS="$LIBS -lm" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([[#ifndef __NO_MATH_INLINES + # define __NO_MATH_INLINES 1 /* for glibc */ + #endif + #include + double (*funcptr) (double, int) = ldexp; + double x;]], + [[return ldexp (x, -1) > 0;]])], + [gl_cv_func_ldexp_in_libm=yes], + [gl_cv_func_ldexp_in_libm=no]) + LIBS="$save_LIBS" + ]) + if test $gl_cv_func_ldexp_in_libm = yes; then + LDEXP_LIBM=-lm + fi + fi + AC_SUBST([LDEXP_LIBM]) +]) + +dnl Test whether ldexp() can be used without linking with libm. +dnl Set gl_cv_func_ldexp_no_libm to 'yes' or 'no' accordingly. +AC_DEFUN([gl_CHECK_LDEXP_NO_LIBM], +[ + AC_CACHE_CHECK([whether ldexp() can be used without linking with libm], + [gl_cv_func_ldexp_no_libm], + [ + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([[#ifndef __NO_MATH_INLINES + # define __NO_MATH_INLINES 1 /* for glibc */ + #endif + #include + double (*funcptr) (double, int) = ldexp; + double x;]], + [[return ldexp (x, -1) > 0;]])], + [gl_cv_func_ldexp_no_libm=yes], + [gl_cv_func_ldexp_no_libm=no]) + ]) +]) diff --git a/m4/lib-link.m4 b/m4/lib-link.m4 index b024dd4e9..e7c9ba9d3 100644 --- a/m4/lib-link.m4 +++ b/m4/lib-link.m4 @@ -1,4 +1,4 @@ -# lib-link.m4 serial 25 (gettext-0.18.2) +# lib-link.m4 serial 26 (gettext-0.18.2) dnl Copyright (C) 2001-2011 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -116,6 +116,8 @@ AC_DEFUN([AC_LIB_HAVE_LINKFLAGS], dnl Determine the platform dependent parameters needed to use rpath: dnl acl_libext, dnl acl_shlibext, +dnl acl_libname_spec, +dnl acl_library_names_spec, dnl acl_hardcode_libdir_flag_spec, dnl acl_hardcode_libdir_separator, dnl acl_hardcode_direct, diff --git a/m4/longlong.m4 b/m4/longlong.m4 index a4d95aa1a..aed816cfa 100644 --- a/m4/longlong.m4 +++ b/m4/longlong.m4 @@ -1,4 +1,4 @@ -# longlong.m4 serial 14 +# longlong.m4 serial 16 dnl Copyright (C) 1999-2007, 2009-2011 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -7,8 +7,8 @@ dnl with or without modifications, as long as this notice is preserved. dnl From Paul Eggert. # Define HAVE_LONG_LONG_INT if 'long long int' works. -# This fixes a bug in Autoconf 2.61, but can be removed once we -# assume 2.62 everywhere. +# This fixes a bug in Autoconf 2.61, and can be faster +# than what's in Autoconf 2.62 through 2.68. # Note: If the type 'long long int' exists but is only 32 bits large # (as on some very old compilers), HAVE_LONG_LONG_INT will not be @@ -16,35 +16,39 @@ dnl From Paul Eggert. AC_DEFUN([AC_TYPE_LONG_LONG_INT], [ + AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) AC_CACHE_CHECK([for long long int], [ac_cv_type_long_long_int], - [AC_LINK_IFELSE( - [_AC_TYPE_LONG_LONG_SNIPPET], - [dnl This catches a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004. - dnl If cross compiling, assume the bug isn't important, since - dnl nobody cross compiles for this platform as far as we know. - AC_RUN_IFELSE( - [AC_LANG_PROGRAM( - [[@%:@include - @%:@ifndef LLONG_MAX - @%:@ define HALF \ - (1LL << (sizeof (long long int) * CHAR_BIT - 2)) - @%:@ define LLONG_MAX (HALF - 1 + HALF) - @%:@endif]], - [[long long int n = 1; - int i; - for (i = 0; ; i++) - { - long long int m = n << i; - if (m >> i != n) - return 1; - if (LLONG_MAX / 2 < m) - break; - } - return 0;]])], - [ac_cv_type_long_long_int=yes], - [ac_cv_type_long_long_int=no], - [ac_cv_type_long_long_int=yes])], - [ac_cv_type_long_long_int=no])]) + [ac_cv_type_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + ac_cv_type_long_long_int=$ac_cv_type_unsigned_long_long_int + if test $ac_cv_type_long_long_int = yes; then + dnl Catch a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004. + dnl If cross compiling, assume the bug is not important, since + dnl nobody cross compiles for this platform as far as we know. + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[@%:@include + @%:@ifndef LLONG_MAX + @%:@ define HALF \ + (1LL << (sizeof (long long int) * CHAR_BIT - 2)) + @%:@ define LLONG_MAX (HALF - 1 + HALF) + @%:@endif]], + [[long long int n = 1; + int i; + for (i = 0; ; i++) + { + long long int m = n << i; + if (m >> i != n) + return 1; + if (LLONG_MAX / 2 < m) + break; + } + return 0;]])], + [], + [ac_cv_type_long_long_int=no], + [:]) + fi + fi]) if test $ac_cv_type_long_long_int = yes; then AC_DEFINE([HAVE_LONG_LONG_INT], [1], [Define to 1 if the system has the type `long long int'.]) @@ -52,8 +56,8 @@ AC_DEFUN([AC_TYPE_LONG_LONG_INT], ]) # Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works. -# This fixes a bug in Autoconf 2.61, but can be removed once we -# assume 2.62 everywhere. +# This fixes a bug in Autoconf 2.61, and can be faster +# than what's in Autoconf 2.62 through 2.68. # Note: If the type 'unsigned long long int' exists but is only 32 bits # large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT @@ -64,10 +68,13 @@ AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT], [ AC_CACHE_CHECK([for unsigned long long int], [ac_cv_type_unsigned_long_long_int], - [AC_LINK_IFELSE( - [_AC_TYPE_LONG_LONG_SNIPPET], - [ac_cv_type_unsigned_long_long_int=yes], - [ac_cv_type_unsigned_long_long_int=no])]) + [ac_cv_type_unsigned_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + AC_LINK_IFELSE( + [_AC_TYPE_LONG_LONG_SNIPPET], + [], + [ac_cv_type_unsigned_long_long_int=no]) + fi]) if test $ac_cv_type_unsigned_long_long_int = yes; then AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1], [Define to 1 if the system has the type `unsigned long long int'.]) diff --git a/m4/round.m4 b/m4/round.m4 deleted file mode 100644 index a95d905ef..000000000 --- a/m4/round.m4 +++ /dev/null @@ -1,111 +0,0 @@ -# round.m4 serial 10 -dnl Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -AC_DEFUN([gl_FUNC_ROUND], -[ - m4_divert_text([DEFAULTS], [gl_round_required=plain]) - AC_REQUIRE([gl_MATH_H_DEFAULTS]) - dnl Persuade glibc to declare round(). - AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_DECLS([round], , , [#include ]) - if test "$ac_cv_have_decl_round" = yes; then - gl_CHECK_MATH_LIB([ROUND_LIBM], [x = round (x);]) - if test "$ROUND_LIBM" != missing; then - dnl Test whether round() produces correct results. On NetBSD 3.0, for - dnl x = 1/2 - 2^-54, the system's round() returns a wrong result. - AC_REQUIRE([AC_PROG_CC]) - AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_CACHE_CHECK([whether round works], [gl_cv_func_round_works], - [ - save_LIBS="$LIBS" - LIBS="$LIBS $ROUND_LIBM" - AC_RUN_IFELSE([AC_LANG_SOURCE([[ -#include -#include -int main() -{ - /* 2^DBL_MANT_DIG. */ - static const double TWO_MANT_DIG = - /* Assume DBL_MANT_DIG <= 5 * 31. - Use the identity - n = floor(n/5) + floor((n+1)/5) + ... + floor((n+4)/5). */ - (double) (1U << (DBL_MANT_DIG / 5)) - * (double) (1U << ((DBL_MANT_DIG + 1) / 5)) - * (double) (1U << ((DBL_MANT_DIG + 2) / 5)) - * (double) (1U << ((DBL_MANT_DIG + 3) / 5)) - * (double) (1U << ((DBL_MANT_DIG + 4) / 5)); - volatile double x = 0.5 - 0.5 / TWO_MANT_DIG; - exit (x < 0.5 && round (x) != 0.0); -}]])], [gl_cv_func_round_works=yes], [gl_cv_func_round_works=no], - [case "$host_os" in - netbsd* | aix*) gl_cv_func_round_works="guessing no";; - *) gl_cv_func_round_works="guessing yes";; - esac - ]) - LIBS="$save_LIBS" - ]) - case "$gl_cv_func_round_works" in - *no) ROUND_LIBM=missing ;; - esac - fi - if test "$ROUND_LIBM" = missing; then - REPLACE_ROUND=1 - fi - m4_ifdef([gl_FUNC_ROUND_IEEE], [ - if test $gl_round_required = ieee && test $REPLACE_ROUND = 0; then - AC_CACHE_CHECK([whether round works according to ISO C 99 with IEC 60559], - [gl_cv_func_round_ieee], - [ - save_LIBS="$LIBS" - LIBS="$LIBS $ROUND_LIBM" - AC_RUN_IFELSE( - [AC_LANG_SOURCE([[ -#ifndef __NO_MATH_INLINES -# define __NO_MATH_INLINES 1 /* for glibc */ -#endif -#include -]gl_DOUBLE_MINUS_ZERO_CODE[ -]gl_DOUBLE_SIGNBIT_CODE[ -int main() -{ - /* Test whether round (-0.0) is -0.0. */ - if (signbitd (minus_zerod) && !signbitd (round (minus_zerod))) - return 1; - return 0; -} - ]])], - [gl_cv_func_round_ieee=yes], - [gl_cv_func_round_ieee=no], - [gl_cv_func_round_ieee="guessing no"]) - LIBS="$save_LIBS" - ]) - case "$gl_cv_func_round_ieee" in - *yes) ;; - *) REPLACE_ROUND=1 ;; - esac - fi - ]) - else - HAVE_DECL_ROUND=0 - fi - if test $HAVE_DECL_ROUND = 0 || test $REPLACE_ROUND = 1; then - AC_LIBOBJ([round]) - gl_FUNC_FLOOR_LIBS - gl_FUNC_CEIL_LIBS - ROUND_LIBM= - dnl Append $FLOOR_LIBM to ROUND_LIBM, avoiding gratuitous duplicates. - case " $ROUND_LIBM " in - *" $FLOOR_LIBM "*) ;; - *) ROUND_LIBM="$ROUND_LIBM $FLOOR_LIBM" ;; - esac - dnl Append $CEIL_LIBM to ROUND_LIBM, avoiding gratuitous duplicates. - case " $ROUND_LIBM " in - *" $CEIL_LIBM "*) ;; - *) ROUND_LIBM="$ROUND_LIBM $CEIL_LIBM" ;; - esac - fi - AC_SUBST([ROUND_LIBM]) -]) diff --git a/m4/stat.m4 b/m4/stat.m4 index 4883fe25e..27f82d5a9 100644 --- a/m4/stat.m4 +++ b/m4/stat.m4 @@ -1,4 +1,4 @@ -# serial 6 +# serial 7 # Copyright (C) 2009-2011 Free Software Foundation, Inc. # @@ -9,7 +9,6 @@ AC_DEFUN([gl_FUNC_STAT], [ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_REQUIRE([gl_AC_DOS]) AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) AC_CHECK_FUNCS_ONCE([lstat]) dnl mingw is the only known platform where stat(".") and stat("./") differ diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 26654c68e..e7d0d0765 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 37 +# stdint.m4 serial 39 dnl Copyright (C) 2001-2011 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -27,6 +27,15 @@ AC_DEFUN([gl_STDINT_H], fi AC_SUBST([HAVE_UNSIGNED_LONG_LONG_INT]) + dnl Check for , in the same way as gl_WCHAR_H does. + AC_CHECK_HEADERS_ONCE([wchar.h]) + if test $ac_cv_header_wchar_h = yes; then + HAVE_WCHAR_H=1 + else + HAVE_WCHAR_H=0 + fi + AC_SUBST([HAVE_WCHAR_H]) + dnl Check for . dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_inttypes_h. if test $ac_cv_header_inttypes_h = yes; then @@ -292,10 +301,6 @@ static const char *macro_values[] = fi AC_SUBST([HAVE_SYS_BITYPES_H]) - dnl Check for (missing in Linux uClibc when built without wide - dnl character support). - AC_CHECK_HEADERS_ONCE([wchar.h]) - gl_STDINT_TYPE_PROPERTIES STDINT_H=stdint.h fi diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4 index b6163d680..7f3ae5629 100644 --- a/m4/stdio_h.m4 +++ b/m4/stdio_h.m4 @@ -1,4 +1,4 @@ -# stdio_h.m4 serial 32 +# stdio_h.m4 serial 33 dnl Copyright (C) 2007-2011 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -8,7 +8,6 @@ AC_DEFUN([gl_STDIO_H], [ AC_REQUIRE([gl_STDIO_H_DEFAULTS]) AC_REQUIRE([AC_C_INLINE]) - AC_REQUIRE([gl_ASM_SYMBOL_PREFIX]) gl_NEXT_HEADERS([stdio.h]) dnl No need to create extra modules for these functions. Everyone who uses dnl likely needs them. @@ -139,23 +138,3 @@ AC_DEFUN([gl_STDIO_H_DEFAULTS], REPLACE_VSNPRINTF=0; AC_SUBST([REPLACE_VSNPRINTF]) REPLACE_VSPRINTF=0; AC_SUBST([REPLACE_VSPRINTF]) ]) - -dnl Code shared by fseeko and ftello. Determine if large files are supported, -dnl but stdin does not start as a large file by default. -AC_DEFUN([gl_STDIN_LARGE_OFFSET], - [ - AC_CACHE_CHECK([whether stdin defaults to large file offsets], - [gl_cv_var_stdin_large_offset], - [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], -[[#if defined __SL64 && defined __SCLE /* cygwin */ - /* Cygwin 1.5.24 and earlier fail to put stdin in 64-bit mode, making - fseeko/ftello needlessly fail. This bug was fixed in 1.5.25, and - it is easier to do a version check than building a runtime test. */ -# include -# if CYGWIN_VERSION_DLL_COMBINED < CYGWIN_VERSION_DLL_MAKE_COMBINED (1005, 25) - choke me -# endif -#endif]])], - [gl_cv_var_stdin_large_offset=yes], - [gl_cv_var_stdin_large_offset=no])]) -]) diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index d28b552e9..25fdada0d 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,4 +1,4 @@ -# stdlib_h.m4 serial 36 +# stdlib_h.m4 serial 37 dnl Copyright (C) 2007-2011 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -44,6 +44,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], GNULIB_GETSUBOPT=0; AC_SUBST([GNULIB_GETSUBOPT]) GNULIB_GRANTPT=0; AC_SUBST([GNULIB_GRANTPT]) GNULIB_MALLOC_POSIX=0; AC_SUBST([GNULIB_MALLOC_POSIX]) + GNULIB_MBTOWC=0; AC_SUBST([GNULIB_MBTOWC]) GNULIB_MKDTEMP=0; AC_SUBST([GNULIB_MKDTEMP]) GNULIB_MKOSTEMP=0; AC_SUBST([GNULIB_MKOSTEMP]) GNULIB_MKOSTEMPS=0; AC_SUBST([GNULIB_MKOSTEMPS]) @@ -62,6 +63,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], GNULIB_SYSTEM_POSIX=0; AC_SUBST([GNULIB_SYSTEM_POSIX]) GNULIB_UNLOCKPT=0; AC_SUBST([GNULIB_UNLOCKPT]) GNULIB_UNSETENV=0; AC_SUBST([GNULIB_UNSETENV]) + GNULIB_WCTOMB=0; AC_SUBST([GNULIB_WCTOMB]) dnl Assume proper GNU behavior unless another module says otherwise. HAVE__EXIT=1; AC_SUBST([HAVE__EXIT]) HAVE_ATOLL=1; AC_SUBST([HAVE_ATOLL]) @@ -91,6 +93,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], REPLACE_CALLOC=0; AC_SUBST([REPLACE_CALLOC]) REPLACE_CANONICALIZE_FILE_NAME=0; AC_SUBST([REPLACE_CANONICALIZE_FILE_NAME]) REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC]) + REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC]) REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP]) REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) REPLACE_REALLOC=0; AC_SUBST([REPLACE_REALLOC]) @@ -98,4 +101,5 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], REPLACE_SETENV=0; AC_SUBST([REPLACE_SETENV]) REPLACE_STRTOD=0; AC_SUBST([REPLACE_STRTOD]) REPLACE_UNSETENV=0; AC_SUBST([REPLACE_UNSETENV]) + REPLACE_WCTOMB=0; AC_SUBST([REPLACE_WCTOMB]) ]) diff --git a/maint.mk b/maint.mk index 606d42ed1..90c22cfed 100644 --- a/maint.mk +++ b/maint.mk @@ -126,8 +126,13 @@ syntax-check-rules := $(sort $(shell sed -n 's/^\(sc_[a-zA-Z0-9_-]*\):.*/\1/p' \ $(srcdir)/$(ME) $(_cfg_mk))) .PHONY: $(syntax-check-rules) -local-checks-available = \ - $(syntax-check-rules) +ifeq ($(shell $(VC_LIST) >/dev/null 2>&1; echo $$?),0) +local-checks-available += $(syntax-check-rules) +else +local-checks-available += no-vc-detected +no-vc-detected: + @echo "No version control files detected; skipping syntax check" +endif .PHONY: $(local-checks-available) # Arrange to print the name of each syntax-checking rule just before running it. @@ -773,17 +778,22 @@ sc_prohibit_cvs_keyword: # perl -ln -0777 -e '/\n(\n+)$/ and print "$ARGV: ".length $1' ... # but that would be far less efficient, reading the entire contents # of each file, rather than just the last two bytes of each. +# In addition, while the code below detects both blank lines and a missing +# newline at EOF, the above detects only the former. # # This is a perl script that is expected to be the single-quoted argument # to a command-line "-le". The remaining arguments are file names. -# Print the name of each file that ends in two or more newline bytes. +# Print the name of each file that ends in exactly one newline byte. +# I.e., warn if there are blank lines (2 or more newlines), or if the +# last byte is not a newline. However, currently we don't complain +# about any file that contains exactly one byte. # Exit nonzero if at least one such file is found, otherwise, exit 0. # Warn about, but otherwise ignore open failure. Ignore seek/read failure. # # Use this if you want to remove trailing empty lines from selected files: # perl -pi -0777 -e 's/\n\n+$/\n/' files... # -detect_empty_lines_at_EOF_ = \ +require_exactly_one_NL_at_EOF_ = \ foreach my $$f (@ARGV) \ { \ open F, "<", $$f or (warn "failed to open $$f: $$!\n"), next; \ @@ -793,12 +803,14 @@ detect_empty_lines_at_EOF_ = \ defined $$p and $$p = sysread F, $$last_two_bytes, 2; \ close F; \ $$c = "ignore read failure"; \ - $$p && $$last_two_bytes eq "\n\n" and (print $$f), $$fail=1; \ + $$p && ($$last_two_bytes eq "\n\n" \ + || substr ($$last_two_bytes,1) ne "\n") \ + and (print $$f), $$fail=1; \ } \ END { exit defined $$fail } sc_prohibit_empty_lines_at_EOF: - @perl -le '$(detect_empty_lines_at_EOF_)' $$($(VC_LIST_EXCEPT)) \ - || { echo '$(ME): the above files end with empty line(s)' \ + @perl -le '$(require_exactly_one_NL_at_EOF_)' $$($(VC_LIST_EXCEPT)) \ + || { echo '$(ME): empty line(s) or no newline at EOF' \ 1>&2; exit 1; } || :; \ # Make sure we don't use st_blocks. Use ST_NBLOCKS instead. From d82f8518b96bbfa4f29e03d922369c37b64824d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 10 Mar 2011 22:24:23 +0100 Subject: [PATCH 097/183] FFI: Return the right alignment for structures. * libguile/foreign.c (scm_alignof): Fix handling of structure alignment. Reported by Aidan Gauland . * test-suite/tests/foreign.test ("structs")["alignof { int8, double, int8 }", "int8, { int8, double, int8 }, int16"]: New tests. --- libguile/foreign.c | 20 ++++++++++++++++++-- test-suite/tests/foreign.test | 12 ++++++++++++ 2 files changed, 30 insertions(+), 2 deletions(-) diff --git a/libguile/foreign.c b/libguile/foreign.c index 6f008e761..0f07c60ff 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -402,8 +402,24 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type), /* a pointer */ return scm_from_size_t (alignof (void*)); else if (scm_is_pair (type)) - /* a struct, yo */ - return scm_alignof (scm_car (type)); + { + /* TYPE is a structure. Section 3-3 of the i386, x86_64, PowerPC, + and SPARC P.S. of the System V ABI all say: "Aggregates + (structures and arrays) and unions assume the alignment of + their most strictly aligned component." */ + size_t max; + + for (max = 0; scm_is_pair (type); type = SCM_CDR (type)) + { + size_t align; + + align = scm_to_size_t (scm_alignof (SCM_CAR (type))); + if (align > max) + max = align; + } + + return scm_from_size_t (max); + } else scm_wrong_type_arg (FUNC_NAME, 1, type); } diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 3569c8a52..b05363977 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -228,6 +228,11 @@ (>= (sizeof layout) (reduce + 0.0 (map sizeof layout))))) + (pass-if "alignof { int8, double, int8 }" + ;; alignment of the most strictly aligned component + (let ((layout (list int8 double int8))) + (= (alignof layout) (alignof double)))) + (pass-if "parse-c-struct" (let ((layout (list int64 uint8)) (data (list -300 43))) @@ -266,6 +271,13 @@ (pass-if "int8, pointer, short, double" (let ((layout (list int8 '* short double)) (data (list 77 %null-pointer -42 3.14))) + (equal? (parse-c-struct (make-c-struct layout data) + layout) + data))) + + (pass-if "int8, { int8, double, int8 }, int16" + (let ((layout (list int8 (list int8 double int8) int16)) + (data (list 77 (list 42 4.2 55) 88))) (equal? (parse-c-struct (make-c-struct layout data) layout) data)))) From 514642d3c7b5406952e5461918b718e13a06a2c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 10 Mar 2011 22:24:40 +0100 Subject: [PATCH 098/183] Thanks, Aidan. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index f912c7b57..a06ba4a22 100644 --- a/THANKS +++ b/THANKS @@ -62,6 +62,7 @@ For fixes or providing information which led to a fix: Barry Fishman Charles Gagnon Fu-gangqiang + Aidan Gauland Peter Gavin Nils Gey Eric Gillespie, Jr From 06fc34c23f2c6987ba1dc8cbf5a084ff24a83e53 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 10 Mar 2011 17:35:19 -0500 Subject: [PATCH 099/183] Fix bug to make `string=' much faster * libguile/srfi-13.c (scm_string_eq): Fix a bug which caused the slow general string_compare function to be used for strings of unequal lengths. --- libguile/srfi-13.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index ab933c2ad..06d7f3b55 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -1181,7 +1181,9 @@ SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0, len1 = scm_i_string_length (s1); len2 = scm_i_string_length (s2); - if (SCM_LIKELY (len1 == len2)) + if (len1 != len2) + return SCM_BOOL_F; + else { if (!scm_i_is_narrow_string (s1)) len1 *= 4; From bfb85df7084e26a276142cdc62315a85c7a0ba20 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 11 Mar 2011 20:53:13 +0100 Subject: [PATCH 100/183] fix port-filename without readline to match the docs * libguile/init.c (stream_body, scm_standard_stream_to_port): Don't name stdin, stdout, and stderr -- at least not as strings. That confuses any code which tries to treat port-filename as a real filename, like the syntax expander, or the `load' procedure/macro. Also this behavior matches the docs now. --- libguile/init.c | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/libguile/init.c b/libguile/init.c index 9b8c4d086..d6a710504 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -157,7 +157,6 @@ typedef struct { int fdes; char *mode; - char *name; } stream_body_data; /* proc to be called in scope of exception handler stream_handler. */ @@ -165,8 +164,7 @@ static SCM stream_body (void *data) { stream_body_data *body_data = (stream_body_data *) data; - SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, - scm_from_locale_string (body_data->name)); + SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, SCM_BOOL_F); SCM_REVEALED (port) = 1; return port; @@ -182,21 +180,19 @@ stream_handler (void *data SCM_UNUSED, } /* Convert a file descriptor to a port, using scm_fdes_to_port. - - NAME is a C string, not a Guile string - set the revealed count for FILE's file descriptor to 1, so that fdes won't be closed when the port object is GC'd. - catch exceptions: allow Guile to be able to start up even if it has been handed bogus stdin/stdout/stderr. replace the bad ports with void ports. */ static SCM -scm_standard_stream_to_port (int fdes, char *mode, char *name) +scm_standard_stream_to_port (int fdes, char *mode) { SCM port; stream_body_data body_data; body_data.fdes = fdes; body_data.mode = mode; - body_data.name = name; port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, stream_handler, NULL); if (scm_is_false (port)) @@ -223,17 +219,11 @@ scm_init_standard_ports () block buffering for higher performance. */ scm_set_current_input_port - (scm_standard_stream_to_port (0, - isatty (0) ? "r0" : "r", - "standard input")); + (scm_standard_stream_to_port (0, isatty (0) ? "r0" : "r")); scm_set_current_output_port - (scm_standard_stream_to_port (1, - isatty (1) ? "w0" : "w", - "standard output")); + (scm_standard_stream_to_port (1, isatty (1) ? "w0" : "w")); scm_set_current_error_port - (scm_standard_stream_to_port (2, - isatty (2) ? "w0" : "w", - "standard error")); + (scm_standard_stream_to_port (2, isatty (2) ? "w0" : "w")); } From b075a6d766c2ffe7c575b63648d8ae0d51b5dd3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 11 Mar 2011 21:01:35 +0100 Subject: [PATCH 101/183] Fix `define-inlinable' in SRFI-9 so that arguments are evaluated only once. * module/srfi/srfi-9.scm (define-inlinable): When inlining, evaluate the arguments only once. Reported by Andreas Rottmann; thanks to Andy Wingo for the elegant solution. * test-suite/tests/srfi-9.test ("side-effecting arguments"): New test prefix. --- module/srfi/srfi-9.scm | 9 ++++++--- test-suite/tests/srfi-9.test | 9 ++++++++- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm index fad570b26..f9449a66f 100644 --- a/module/srfi/srfi-9.scm +++ b/module/srfi/srfi-9.scm @@ -80,15 +80,18 @@ (syntax-case x () ((_ (name formals ...) body ...) (identifier? #'name) - (with-syntax ((proc-name (make-procedure-name #'name))) + (with-syntax ((proc-name (make-procedure-name #'name)) + ((args ...) (generate-temporaries #'(formals ...)))) #`(begin (define (proc-name formals ...) body ...) (define-syntax name (lambda (x) (syntax-case x () - ((_ formals ...) - #'(begin body ...)) + ((_ args ...) + #'((lambda (formals ...) + body ...) + args ...)) (_ (identifier? x) #'proc-name)))))))))) diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test index f8006c440..f26a7a2cd 100644 --- a/test-suite/tests/srfi-9.test +++ b/test-suite/tests/srfi-9.test @@ -94,8 +94,15 @@ (pass-if-exception "set-y! on bar" exception:wrong-type-arg (set-y! b 99))) +(with-test-prefix "side-effecting arguments" + + (pass-if "predicate" + (let ((x 0)) + (and (foo? (begin (set! x (+ x 1)) f)) + (= x 1))))) + (with-test-prefix "non-toplevel" - + (define-record-type :frotz (make-frotz a b) frotz? (a frotz-a) (b frotz-b set-frotz-b!)) From ca33b501a93f8de389c1e3e1bc987f63b6912029 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 13 Mar 2011 16:09:55 +0100 Subject: [PATCH 102/183] Work around weak-value hash table bug in `define-wrapped-pointer-type'. * module/system/foreign.scm (define-wrapped-pointer-type)[wrap]: Use `hash-ref' and `hash-set!' instead of `hash-create-handle!' and `set-cdr!'. --- module/system/foreign.scm | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/module/system/foreign.scm b/module/system/foreign.scm index 781e79369..a657d4460 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -190,9 +190,12 @@ which does the reverse. PRINT must name a user-defined object printer." ;; PTR1 == PTR2 <-> (eq? (wrap PTR1) (wrap PTR2)). (let ((ptr->obj (make-weak-value-hash-table 3000))) (lambda (ptr) - (let ((key+value (hash-create-handle! ptr->obj ptr #f))) - (or (cdr key+value) - (let ((o (%wrap ptr))) - (set-cdr! key+value o) - o)))))) + ;; XXX: We can't use `hash-create-handle!' + + ;; `set-cdr!' here because the former would create a + ;; weak-cdr pair but the latter wouldn't register a + ;; disappearing link (see `scm_hash_fn_set_x'.) + (or (hash-ref ptr->obj ptr) + (let ((o (%wrap ptr))) + (hash-set! ptr->obj ptr o) + o))))) (set-record-type-printer! type-name print))))))) From a6c377f7d8a311b0ce4f9c5900b1c81c27b2d60c Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sun, 13 Mar 2011 22:39:14 +0100 Subject: [PATCH 103/183] Add `get-string-n' and `get-string-n!' for R6RS ports MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * libguile/r6rs-ports.c (scm_get_string_n_x): Implement `get-string-n!' in C for efficiency. * libguile/r6rs-ports.h: Add prototype for this function. * module/ice-9/binary-ports.scm: Export `get-string-n!'. * module/rnrs/io/ports.scm (get-string-n): Implement based on `get-string-n!'. Export both `get-string-n!' and `get-string-n'. * module/rnrs.scm: Also export these. * test-suite/tests/r6rs-ports.test (8.2.9 Textual input): Add a few tests for `get-string-n' and `get-string-n!'. Signed-off-by: Ludovic Courtès --- libguile/r6rs-ports.c | 42 +++++++++++++++++++++++++++++++- libguile/r6rs-ports.h | 3 ++- module/ice-9/binary-ports.scm | 1 + module/rnrs.scm | 3 ++- module/rnrs/io/ports.scm | 16 ++++++++++-- test-suite/tests/r6rs-ports.test | 18 ++++++++++++++ 6 files changed, 78 insertions(+), 5 deletions(-) diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 8058ca074..1f724158a 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -1221,6 +1221,46 @@ SCM_DEFINE (scm_i_make_transcoded_port, } #undef FUNC_NAME + +/* Textual I/O */ + +SCM_DEFINE (scm_get_string_n_x, + "get-string-n!", 4, 0, 0, + (SCM port, SCM str, SCM start, SCM count), + "Read up to @var{count} characters from @var{port} into " + "@var{str}, starting at @var{start}. If no characters " + "can be read before the end of file is encountered, the end " + "of file object is returned. Otherwise, the number of " + "characters read is returned.") +#define FUNC_NAME s_scm_get_string_n_x +{ + size_t c_start, c_count, c_len, c_end, j; + scm_t_wchar c; + + SCM_VALIDATE_OPINPORT (1, port); + SCM_VALIDATE_STRING (2, str); + c_len = scm_c_string_length (str); + c_start = scm_to_size_t (start); + c_count = scm_to_size_t (count); + c_end = c_start + c_count; + + if (SCM_UNLIKELY (c_end > c_len)) + scm_out_of_range (FUNC_NAME, count); + + for (j = c_start; j < c_end; j++) + { + c = scm_getc (port); + if (c == EOF) + { + size_t chars_read = j - c_start; + return chars_read == 0 ? SCM_EOF_VAL : scm_from_size_t (chars_read); + } + scm_c_string_set_x (str, j, SCM_MAKE_CHAR (c)); + } + return count; +} +#undef FUNC_NAME + /* Initialization. */ diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h index edde00520..2ae3e765b 100644 --- a/libguile/r6rs-ports.h +++ b/libguile/r6rs-ports.h @@ -1,7 +1,7 @@ #ifndef SCM_R6RS_PORTS_H #define SCM_R6RS_PORTS_H -/* Copyright (C) 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -38,6 +38,7 @@ SCM_API SCM scm_put_u8 (SCM, SCM); SCM_API SCM scm_put_bytevector (SCM, SCM, SCM, SCM); SCM_API SCM scm_open_bytevector_output_port (SCM); SCM_API SCM scm_make_custom_binary_output_port (SCM, SCM, SCM, SCM, SCM); +SCM_API SCM scm_get_string_n_x (SCM, SCM, SCM, SCM); SCM_API void scm_init_r6rs_ports (void); SCM_INTERNAL void scm_register_r6rs_ports (void); diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm index 63d09cf21..c07900b0d 100644 --- a/module/ice-9/binary-ports.scm +++ b/module/ice-9/binary-ports.scm @@ -37,6 +37,7 @@ get-bytevector-n! get-bytevector-some get-bytevector-all + get-string-n! put-u8 put-bytevector open-bytevector-output-port diff --git a/module/rnrs.scm b/module/rnrs.scm index 476a3ab2d..77090d0e1 100644 --- a/module/rnrs.scm +++ b/module/rnrs.scm @@ -182,7 +182,8 @@ make-custom-textual-output-port call-with-string-output-port flush-output-port put-string - get-char get-datum get-line get-string-all lookahead-char + get-char get-datum get-line get-string-all get-string-n get-string-n! + lookahead-char put-char put-datum put-string standard-input-port standard-output-port standard-error-port diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index d3a81b7c7..d3b16ac63 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -68,8 +68,9 @@ put-u8 put-bytevector ;; textual input - get-char get-datum get-line get-string-all lookahead-char - + get-char get-datum get-line get-string-all get-string-n get-string-n! + lookahead-char + ;; textual output put-char put-datum put-string @@ -386,6 +387,17 @@ return the characters accumulated in that port." (define (get-string-all port) (with-i/o-decoding-error (read-delimited "" port 'concat))) +(define (get-string-n port count) + "Read up to @var{count} characters from @var{port}. +If no characters could be read before encountering the end of file, +return the end-of-file object, otherwise return a string containing +the characters read." + (let* ((s (make-string count)) + (rv (get-string-n! port s 0 count))) + (cond ((eof-object? rv) rv) + ((= rv count) s) + (else (substring/shared s 0 rv))))) + (define (lookahead-char port) (with-i/o-decoding-error (peek-char port))) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index df056a416..fe2197fe4 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -567,6 +567,24 @@ (put-string tp "The letter λ cannot be represented in Latin-1.") #f))))) +(with-test-prefix "8.2.9 Textual input" + + (pass-if "get-string-n [short]" + (let ((port (open-input-string "GNU Guile"))) + (string=? "GNU " (get-string-n port 4)))) + (pass-if "get-string-n [long]" + (let ((port (open-input-string "GNU Guile"))) + (string=? "GNU Guile" (get-string-n port 256)))) + (pass-if "get-string-n [eof]" + (let ((port (open-input-string ""))) + (eof-object? (get-string-n port 4)))) + + (pass-if "get-string-n! [short]" + (let ((port (open-input-string "GNU Guile")) + (s (string-copy "Isn't XXX great?"))) + (and (= 3 (get-string-n! port s 6 3)) + (string=? s "Isn't GNU great?"))))) + ;;; Local Variables: ;;; mode: scheme ;;; eval: (put 'guard 'scheme-indent-function 1) From 74571cfd3b27b79567f27fc43815d08ec1f402cc Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sun, 13 Mar 2011 22:39:26 +0100 Subject: [PATCH 104/183] Export `current-*-port' from `(rnrs io ports)' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * module/rnrs/io/ports.scm: Export `current-input-port', `current-output-port' and `current-error-port' (see R6RS 8.2.7 "Input ports" and 8.2.10 "Output ports"). Signed-off-by: Ludovic Courtès --- module/rnrs/io/ports.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index d3b16ac63..662db1908 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -76,6 +76,7 @@ ;; standard ports standard-input-port standard-output-port standard-error-port + current-input-port current-output-port current-error-port ;; condition types &i/o i/o-error? make-i/o-error From ead04a04cd38909d0d40f1ba7885372c9c65ff38 Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sun, 13 Mar 2011 23:14:10 +0100 Subject: [PATCH 105/183] Enhance transcoder-related functionality of `(rnrs io ports)' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * module/rnrs/io/ports.scm (transcoder-eol-style) (transcoder-error-handling-mode): Export these. (textual-port?): Implement this procedure and export it. * module/rnrs.scm: Export these here as well. * module/rnrs/io/ports.scm (port-transcoder): Implement this procedure. (binary-port?): Treat only ports without an encoding as binary ports, add docstring. (standard-input-port, standard-output-port, standard-error-port): Ensure these are created without an encoding. (eol-style): Add `none' as enumeration member. (native-eol-style): Switch to `none' from `lf'. * test-suite/tests/r6rs-ports.test (7.2.7 Input ports) (8.2.10 Output ports): Test binary-ness of `standard-input-port', `standard-output-port' and `standard-error-port'. (8.2.6 Input and output ports): Add test for `port-transcoder'. Signed-off-by: Ludovic Courtès --- module/rnrs.scm | 6 +++-- module/rnrs/io/ports.scm | 42 +++++++++++++++++++++++++------- test-suite/tests/r6rs-ports.test | 32 +++++++++++++++++++++--- 3 files changed, 66 insertions(+), 14 deletions(-) diff --git a/module/rnrs.scm b/module/rnrs.scm index 77090d0e1..9fff820b3 100644 --- a/module/rnrs.scm +++ b/module/rnrs.scm @@ -162,12 +162,14 @@ file-options buffer-mode buffer-mode? eol-style native-eol-style error-handling-mode - make-transcoder transcoder-codec native-transcoder + make-transcoder transcoder-codec transcoder-eol-style + transcoder-error-handling-mode native-transcoder latin-1-codec utf-8-codec utf-16-codec eof-object? port? input-port? output-port? eof-object port-eof? port-transcoder - binary-port? transcoded-port port-position set-port-position! + binary-port? textual-port? transcoded-port + port-position set-port-position! port-has-port-position? port-has-set-port-position!? close-port call-with-port open-bytevector-input-port make-custom-binary-input-port get-u8 diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index 662db1908..04d167a2c 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -32,13 +32,14 @@ ;; auxiliary types file-options buffer-mode buffer-mode? eol-style native-eol-style error-handling-mode - make-transcoder transcoder-codec native-transcoder + make-transcoder transcoder-codec transcoder-eol-style + transcoder-error-handling-mode native-transcoder latin-1-codec utf-8-codec utf-16-codec ;; input & output ports port? input-port? output-port? port-eof? - port-transcoder binary-port? transcoded-port + port-transcoder binary-port? textual-port? transcoded-port port-position set-port-position! port-has-port-position? port-has-set-port-position!? call-with-port close-port @@ -129,11 +130,11 @@ (enum-set-member? symbol (enum-set-universe (buffer-modes)))) (define-enumeration eol-style - (lf cr crlf nel crnel ls) + (lf cr crlf nel crnel ls none) eol-styles) (define (native-eol-style) - (eol-style lf)) + (eol-style none)) (define-enumeration error-handling-mode (ignore raise replace) @@ -190,10 +191,30 @@ ;;; (define (port-transcoder port) - (error "port transcoders are not supported" port)) + "Return the transcoder object associated with @var{port}, or @code{#f} +if the port has no transcoder." + (cond ((port-encoding port) + => (lambda (encoding) + (make-transcoder + encoding + (native-eol-style) + (case (port-conversion-strategy port) + ((error) 'raise) + ((substitute) 'replace) + (else + (assertion-violation 'port-transcoder + "unsupported error handling mode")))))) + (else + #f))) (define (binary-port? port) - ;; So far, we don't support transcoders other than the binary transcoder. + "Returns @code{#t} if @var{port} does not have an associated encoding, +@code{#f} otherwise." + (not (port-encoding port))) + +(define (textual-port? port) + "Always returns @var{#t}, as all ports can be used for textual I/O in +Guile." #t) (define (port-eof? port) @@ -408,13 +429,16 @@ the characters read." ;;; (define (standard-input-port) - (dup->inport 0)) + (with-fluids ((%default-port-encoding #f)) + (dup->inport 0))) (define (standard-output-port) - (dup->outport 1)) + (with-fluids ((%default-port-encoding #f)) + (dup->outport 1))) (define (standard-error-port) - (dup->outport 2)) + (with-fluids ((%default-port-encoding #f)) + (dup->outport 2))) ) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index fe2197fe4..70b5853b2 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -397,7 +397,11 @@ (close-port port) (gc) ; Test for marking a closed port. - closed?))) + closed?)) + + (pass-if "standard-input-port is binary" + (with-fluids ((%default-port-encoding "UTF-8")) + (binary-port? (standard-input-port))))) (with-test-prefix "8.2.10 Output ports" @@ -509,7 +513,15 @@ (put-bytevector port source) (and (= sink-pos (bytevector-length source)) (not eof?) - (bytevector=? sink source))))) + (bytevector=? sink source)))) + + (pass-if "standard-output-port is binary" + (with-fluids ((%default-port-encoding "UTF-8")) + (binary-port? (standard-output-port)))) + + (pass-if "standard-error-port is binary" + (with-fluids ((%default-port-encoding "UTF-8")) + (binary-port? (standard-error-port))))) (with-test-prefix "8.2.6 Input and output ports" @@ -565,7 +577,21 @@ (char=? (i/o-encoding-error-char c) #\λ) (bytevector=? (get) (string->utf8 "The letter "))))) (put-string tp "The letter λ cannot be represented in Latin-1.") - #f))))) + #f)))) + + (pass-if "port-transcoder [binary port]" + (not (port-transcoder (open-bytevector-input-port #vu8())))) + + (pass-if "port-transcoder [transcoded port]" + (let* ((p (transcoded-port (open-bytevector-input-port (string->utf8 "foo")) + (make-transcoder (utf-8-codec)))) + (t (port-transcoder p))) + (and t + (transcoder-codec t) + (eq? (native-eol-style) + (transcoder-eol-style t)) + (eq? (error-handling-mode replace) + (transcoder-error-handling-mode t)))))) (with-test-prefix "8.2.9 Textual input" From 958173e489c69b2f9e3c83752713a89e3ea3e79d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 13 Mar 2011 23:21:07 +0100 Subject: [PATCH 106/183] doc: Remove "lack of support for Unicode I/O and strings". * doc/ref/api-io.texi (R6RS I/O Ports): Remove 1.8ish comment. --- doc/ref/api-io.texi | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 6a50424a4..02c184986 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -1155,8 +1155,7 @@ string I/O, that complement or refine Guile's historical port API presented above (@pxref{Input and Output}). @c FIXME: Update description when implemented. -@emph{Note}: The implementation of this R6RS API is currently far from -complete, notably due to the lack of support for Unicode I/O and strings. +@emph{Note}: The implementation of this R6RS API is not complete yet. @menu * R6RS End-of-File:: The end-of-file object. From 9b709b0fe1ec5a71903e07d21006441d15e0c1ed Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 15 Mar 2011 23:33:32 +0100 Subject: [PATCH 107/183] fix frame dynamic linkage in the face of partial continuation application * libguile/vm-i-system.c (new-frame): Though it was appealing to set the dynamic link here on the incomplete frame, we no longer do that, for the reasons mentioned in the code. (call, mv-call): Adapt to set the frame's dynamic link. * libguile/vm-engine.c (vm_engine): Don't set dynamic link here, even for boot program. * libguile/frames.c (scm_frame_num_locals, scm_frame_local_ref) (scm_frame_local_set_x): Fix up not-yet-active frame detection. --- libguile/frames.c | 6 +++--- libguile/vm-engine.c | 2 +- libguile/vm-i-system.c | 49 +++++++++++++++++++++++++++++++----------- 3 files changed, 40 insertions(+), 17 deletions(-) diff --git a/libguile/frames.c b/libguile/frames.c index bc1bb82a8..62ba23fff 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -124,7 +124,7 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0, p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); while (p <= sp) { - if (p + 1 < sp && p[1] == (SCM)0) + if (p[0] == (SCM)0) /* skip over not-yet-active frame */ p += 3; else @@ -154,7 +154,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0, p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); while (p <= sp) { - if (p + 1 < sp && p[1] == (SCM)0) + if (p[0] == (SCM)0) /* skip over not-yet-active frame */ p += 3; else if (n == i) @@ -186,7 +186,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0, p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); while (p <= sp) { - if (p + 1 < sp && p[1] == (SCM)0) + if (p[0] == (SCM)0) /* skip over not-yet-active frame */ p += 3; else if (n == i) diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 20d9ed2c8..4b0ca3ec3 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -93,7 +93,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) fp = sp + 1; ip = SCM_C_OBJCODE_BASE (bp); /* MV-call frame, function & arguments */ - PUSH ((SCM)fp); /* dynamic link */ + PUSH (0); /* dynamic link */ PUSH (0); /* mvra */ PUSH (0); /* ra */ PUSH (prog); diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 57712cabd..980d22afe 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -756,9 +756,14 @@ VM_DEFINE_INSTRUCTION (52, new_frame, "new-frame", 0, 0, 3) { /* NB: if you change this, see frames.c:vm-frame-num-locals */ /* and frames.h, vm-engine.c, etc of course */ - PUSH ((SCM)fp); /* dynamic link */ - PUSH (0); /* mvra */ - PUSH (0); /* ra */ + + /* We don't initialize the dynamic link here because we don't actually + know that this frame will point to the current fp: it could be + placed elsewhere on the stack if captured in a partial + continuation, and invoked from some other context. */ + PUSH (0); /* dynamic link */ + PUSH (0); /* mvra */ + PUSH (0); /* ra */ NEXT; } @@ -790,11 +795,20 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1) } CACHE_PROGRAM (); - fp = sp - nargs + 1; - ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); - ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); - SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); - SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0); + + { + SCM *old_fp = fp; + + fp = sp - nargs + 1; + + ASSERT (SCM_FRAME_DYNAMIC_LINK (fp) == 0); + ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); + ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); + SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp); + SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); + SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0); + } + ip = SCM_C_OBJCODE_BASE (bp); PUSH_CONTINUATION_HOOK (); APPLY_HOOK (); @@ -1091,11 +1105,20 @@ VM_DEFINE_INSTRUCTION (62, mv_call, "mv-call", 4, -1, 1) } CACHE_PROGRAM (); - fp = sp - nargs + 1; - ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); - ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); - SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); - SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra); + + { + SCM *old_fp = fp; + + fp = sp - nargs + 1; + + ASSERT (SCM_FRAME_DYNAMIC_LINK (fp) == 0); + ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); + ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); + SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp); + SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); + SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra); + } + ip = SCM_C_OBJCODE_BASE (bp); PUSH_CONTINUATION_HOOK (); APPLY_HOOK (); From f5fc7e5710438389b21c5c754e959a5554561868 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 15 Mar 2011 23:54:06 +0100 Subject: [PATCH 108/183] add more prompt/abort tests * test-suite/tests/control.test: Use c&e tests for most test blocks. Note that this did not catch the recent bug. ("reified continuations"): Add a new test for capturing partial continuations containing pending call frames. Before these would contain dynamic links pointing out of the continuation segment, which would not be relocated; now, the dynamic links are only made when the frames are activated. Thanks to Wolfgang J Moeller for the bug report and test case. --- test-suite/tests/control.test | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test index 682c69f1e..ce2e1bf0a 100644 --- a/test-suite/tests/control.test +++ b/test-suite/tests/control.test @@ -1,7 +1,7 @@ ;;;; -*- scheme -*- ;;;; control.test --- test suite for delimited continuations ;;;; -;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -27,7 +27,7 @@ ;; For these, the compiler should be able to prove that "k" is not referenced, ;; so it avoids reifying the continuation. Since that's a slightly different ;; codepath, we test them both. -(with-test-prefix "escape-only continuations" +(with-test-prefix/c&e "escape-only continuations" (pass-if "no values, normal exit" (equal? '() (call-with-values @@ -80,7 +80,7 @@ args))))) ;;; And the case in which the compiler has to reify the continuation. -(with-test-prefix "reified continuations" +(with-test-prefix/c&e "reified continuations" (pass-if "no values, normal exit" (equal? '() (call-with-values @@ -133,10 +133,20 @@ (abort 'foo 'bar 'baz) (error "unexpected exit")) (lambda args - args)))))) + args))))) + + (pass-if "reified pending call frames, instantiated elsewhere on the stack" + (equal? 'foo + ((call-with-prompt + 'p0 + (lambda () + (identity ((abort-to-prompt 'p0) 'foo))) + (lambda (c) c)) + (lambda (x) x))))) + ;; The variants check different cases in the compiler. -(with-test-prefix "restarting partial continuations" +(with-test-prefix/c&e "restarting partial continuations" (pass-if "in side-effect position" (let ((k (% (begin (abort) 'foo) (lambda (k) k)))) @@ -171,6 +181,8 @@ (define fl (make-fluid)) (fluid-set! fl 0) +;; Not c&e as it assumes this block executes once. +;; (with-test-prefix "suspend/resume with fluids" (pass-if "normal" (zero? (% (fluid-ref fl) @@ -212,7 +224,7 @@ (pass-if "post" (equal? (fluid-ref fl) 0)))) -(with-test-prefix "rewinding prompts" +(with-test-prefix/c&e "rewinding prompts" (pass-if "nested prompts" (let ((k (% 'a (% 'b @@ -223,11 +235,11 @@ (lambda (k) k)))) (k)))) -(with-test-prefix "abort to unknown prompt" +(with-test-prefix/c&e "abort to unknown prompt" (pass-if-exception "foo" '(misc-error . "^Abort to unknown prompt") (abort-to-prompt 'does-not-exist))) -(with-test-prefix "the-vm" +(with-test-prefix/c&e "the-vm" (pass-if "unwind changes VMs" (let ((new-vm (make-vm)) From 148c3317691d5b7d2414179031f87905454cb11a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 10:39:02 +0100 Subject: [PATCH 109/183] add pointer->scm, scm->pointer * libguile/foreign.c (scm_pointer_to_scm, scm_scm_to_pointer): New functions, useful to pass and receive SCM values to and from foreign functions. * module/system/foreign.scm: Export the new functions. * doc/ref/api-foreign.texi (Foreign Variables): Add docs. * test-suite/tests/foreign.test ("pointer<->scm"): Tests. --- doc/ref/api-foreign.texi | 14 ++++++++++++++ libguile/foreign.c | 28 ++++++++++++++++++++++++++++ module/system/foreign.scm | 2 ++ test-suite/tests/foreign.test | 11 +++++++++++ 4 files changed, 55 insertions(+) diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index b91439e5a..b5fdd001b 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -568,6 +568,20 @@ A foreign pointer whose value is 0. Return @code{#t} if @var{pointer} is the null pointer, @code{#f} otherwise. @end deffn +For the purpose of passing SCM values directly to foreign functions, and +allowing them to return SCM values, Guile also supports some unsafe +casting operators. + +@deffn {Scheme Procedure} scm->pointer scm +Return a foreign pointer object with the @code{object-address} +of @var{scm}. +@end deffn + +@deffn {Scheme Procedure} pointer->scm pointer +Unsafely cast @var{pointer} to a Scheme object. +Cross your fingers! +@end deffn + @node Void Pointers and Byte Access @subsubsection Void Pointers and Byte Access diff --git a/libguile/foreign.c b/libguile/foreign.c index 0f07c60ff..494ab5b4c 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -177,6 +177,34 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_pointer_to_scm, "pointer->scm", 1, 0, 0, + (SCM pointer), + "Unsafely cast @var{pointer} to a Scheme object.\n" + "Cross your fingers!") +#define FUNC_NAME s_scm_pointer_to_scm +{ + SCM_VALIDATE_POINTER (1, pointer); + + return SCM_PACK ((scm_t_bits) SCM_POINTER_VALUE (pointer)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0, + (SCM scm), + "Return a foreign pointer object with the @code{object-address}\n" + "of @var{scm}.") +#define FUNC_NAME s_scm_scm_to_pointer +{ + SCM ret; + + ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL); + if (SCM_NIMP (ret)) + register_weak_reference (ret, scm); + + return ret; +} +#undef FUNC_NAME + SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0, (SCM pointer, SCM len, SCM offset, SCM uvec_type), "Return a bytevector aliasing the @var{len} bytes pointed\n" diff --git a/module/system/foreign.scm b/module/system/foreign.scm index a657d4460..37f9b41ac 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -37,6 +37,8 @@ null-pointer? pointer? make-pointer + pointer->scm + scm->pointer pointer-address pointer->bytevector diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index b05363977..3ff232eb2 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -66,6 +66,17 @@ (pass-if "not equal?" (not (equal? (make-pointer 123) (make-pointer 456))))) + +(with-test-prefix "pointer<->scm" + + (pass-if "immediates" + (equal? (pointer->scm (scm->pointer #\newline)) + #\newline)) + + (pass-if "non-immediates" + (equal? (pointer->scm (scm->pointer "Hello, world!")) + "Hello, world!"))) + (define-wrapped-pointer-type foo foo? From 03976fee3b342f9da6fff41bc619c45a12372dfa Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 11:42:50 +0100 Subject: [PATCH 110/183] fix code that causes warnings on gcc 4.6 * libguile/arrays.c (scm_i_read_array): * libguile/backtrace.c (display_backtrace_body): * libguile/filesys.c (scm_readdir) * libguile/i18n.c (chr_to_case): * libguile/ports.c (register_finalizer_for_port): * libguile/posix.c (scm_nice): * libguile/stacks.c (scm_make_stack): Clean up a number of set-but-unused vars. Thanks to Douglas Mencken for the report. * libguile/numbers.c (scm_log, scm_exp): Fix a few #if cases that should be #ifdef. --- libguile/arrays.c | 4 +--- libguile/backtrace.c | 5 +---- libguile/filesys.c | 5 +---- libguile/i18n.c | 14 +++++--------- libguile/numbers.c | 8 +++++--- libguile/ports.c | 3 --- libguile/posix.c | 4 +--- libguile/stacks.c | 2 -- 8 files changed, 14 insertions(+), 31 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 89f5e9d09..6724d0071 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -860,7 +860,6 @@ SCM scm_i_read_array (SCM port, int c) { ssize_t rank; - int got_rank; char tag[80]; int tag_len; @@ -888,7 +887,6 @@ scm_i_read_array (SCM port, int c) return SCM_BOOL_F; } rank = 1; - got_rank = 1; tag[0] = 'f'; tag_len = 1; goto continue_reading_tag; diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 7140228c2..db22c17e9 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -429,7 +429,7 @@ display_backtrace_body (struct display_backtrace_args *a) #define FUNC_NAME "display_backtrace_body" { int n_frames, beg, end, n, i, j; - int nfield, indent_p, indentation; + int nfield, indentation; SCM frame, sport, print_state; SCM last_file; scm_print_state *pstate; @@ -482,9 +482,6 @@ display_backtrace_body (struct display_backtrace_args *a) pstate->fancyp = 1; pstate->highlight_objects = a->highlight_objects; - /* First find out if it's reasonable to do indentation. */ - indent_p = 0; - /* Determine size of frame number field. */ j = end; for (i = 0; j > 0; ++i) j /= 10; diff --git a/libguile/filesys.c b/libguile/filesys.c index 68d90d926..96752bcd7 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -845,7 +845,6 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0, { struct dirent_or_dirent64 de; /* just for sizeof */ DIR *ds = (DIR *) SCM_SMOB_DATA_1 (port); - size_t namlen; #ifdef NAME_MAX char buf [SCM_MAX (sizeof (de), sizeof (de) - sizeof (de.d_name) + NAME_MAX + 1)]; @@ -865,8 +864,6 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0, if (! rdent) return SCM_EOF_VAL; - namlen = NAMLEN (rdent); - return (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent)) : SCM_EOF_VAL); } diff --git a/libguile/i18n.c b/libguile/i18n.c index c51df4a2c..da3c220de 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1113,23 +1113,19 @@ chr_to_case (SCM chr, scm_t_locale c_locale, #define FUNC_NAME func_name { int ret; - scm_t_wchar *buf; + scm_t_uint32 c; scm_t_uint32 *convbuf; size_t convlen; - SCM str, convchar; + SCM convchar; - str = scm_i_make_wide_string (1, &buf); - buf[0] = SCM_CHAR (chr); + c = SCM_CHAR (chr); if (c_locale != NULL) RUN_IN_LOCALE_SECTION (c_locale, ret = - u32_locale_tocase ((scm_t_uint32 *) buf, 1, - &convbuf, - &convlen, func)); + u32_locale_tocase (&c, 1, &convbuf, &convlen, func)); else ret = - u32_locale_tocase ((scm_t_uint32 *) buf, 1, &convbuf, - &convlen, func); + u32_locale_tocase (&c, 1, &convbuf, &convlen, func); if (SCM_UNLIKELY (ret != 0)) { diff --git a/libguile/numbers.c b/libguile/numbers.c index f8891fa87..427e77263 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -146,7 +146,7 @@ static double atanh (double x) { return 0.5 * log ((1 + x) / (1 - x)); } #if defined (GUILE_I) -#if HAVE_COMPLEX_DOUBLE +#if defined HAVE_COMPLEX_DOUBLE /* For an SCM object Z which is a complex number (ie. satisfies SCM_COMPLEXP), return its value as a C level "complex double". */ @@ -9449,7 +9449,8 @@ SCM_PRIMITIVE_GENERIC (scm_log, "log", 1, 0, 0, { if (SCM_COMPLEXP (z)) { -#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG && defined (SCM_COMPLEX_VALUE) +#if defined HAVE_COMPLEX_DOUBLE && defined HAVE_CLOG \ + && defined (SCM_COMPLEX_VALUE) return scm_from_complex_double (clog (SCM_COMPLEX_VALUE (z))); #else double re = SCM_COMPLEX_REAL (z); @@ -9534,7 +9535,8 @@ SCM_PRIMITIVE_GENERIC (scm_exp, "exp", 1, 0, 0, { if (SCM_COMPLEXP (z)) { -#if HAVE_COMPLEX_DOUBLE && HAVE_CEXP && defined (SCM_COMPLEX_VALUE) +#if defined HAVE_COMPLEX_DOUBLE && defined HAVE_CEXP \ + && defined (SCM_COMPLEX_VALUE) return scm_from_complex_double (cexp (SCM_COMPLEX_VALUE (z))); #else return scm_c_make_polar (exp (SCM_COMPLEX_REAL (z)), diff --git a/libguile/ports.c b/libguile/ports.c index a48cc8607..8f52e66f1 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -522,12 +522,9 @@ static void finalize_port (GC_PTR, GC_PTR); static SCM_C_INLINE_KEYWORD void register_finalizer_for_port (SCM port) { - long port_type; GC_finalization_proc prev_finalizer; GC_PTR prev_finalization_data; - port_type = SCM_TC2PTOBNUM (SCM_CELL_TYPE (port)); - /* Register a finalizer for PORT so that its iconv CDs get freed and optionally its type's `free' function gets called. */ GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0, diff --git a/libguile/posix.c b/libguile/posix.c index 97e30df2b..a5c72624c 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1713,12 +1713,10 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_nice { - int nice_value; - /* nice() returns "prio-NZERO" on success or -1 on error, but -1 can arise from "prio-NZERO", so an error must be detected from errno changed */ errno = 0; - nice_value = nice (scm_to_int (incr)); + nice (scm_to_int (incr)); if (errno != 0) SCM_SYSERROR; diff --git a/libguile/stacks.c b/libguile/stacks.c index 267b3c404..31bd91b13 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -247,7 +247,6 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, #define FUNC_NAME s_scm_make_stack { long n; - int maxp; SCM frame; SCM stack; SCM inner_cut, outer_cut; @@ -289,7 +288,6 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, /* Count number of frames. Also get stack id tag and check whether there are more stackframes than we want to record (SCM_BACKTRACE_MAXDEPTH). */ - maxp = 0; n = stack_depth (frame); /* Make the stack object. */ From 17ab1dc3d630dcaeee45e1cb42a8f8699585eea0 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 11:43:06 +0100 Subject: [PATCH 111/183] add heap-allocated-since-gc to gc-stats * libguile/gc.c (scm_gc_stats): Use add bytes_since_gc to the alist, under "heap-allocated-since-gc", and remove dead code. --- libguile/gc.c | 39 +++++---------------------------------- 1 file changed, 5 insertions(+), 34 deletions(-) diff --git a/libguile/gc.c b/libguile/gc.c index f2c0179ca..8816a61a6 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -202,23 +202,13 @@ unsigned long scm_gc_ports_collected = 0; static unsigned long protected_obj_count = 0; -SCM_SYMBOL (sym_cells_allocated, "cells-allocated"); +SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); SCM_SYMBOL (sym_heap_size, "heap-size"); SCM_SYMBOL (sym_heap_free_size, "heap-free-size"); SCM_SYMBOL (sym_heap_total_allocated, "heap-total-allocated"); -SCM_SYMBOL (sym_mallocated, "bytes-malloced"); -SCM_SYMBOL (sym_mtrigger, "gc-malloc-threshold"); -SCM_SYMBOL (sym_heap_segments, "cell-heap-segments"); -SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); -SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken"); -SCM_SYMBOL (sym_times, "gc-times"); -SCM_SYMBOL (sym_cells_marked, "cells-marked"); -SCM_SYMBOL (sym_cells_marked_conservatively, "cells-marked-conservatively"); -SCM_SYMBOL (sym_cells_swept, "cells-swept"); -SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); -SCM_SYMBOL (sym_cell_yield, "cell-yield"); +SCM_SYMBOL (sym_heap_allocated_since_gc, "heap-allocated-since-gc"); SCM_SYMBOL (sym_protected_objects, "protected-objects"); -SCM_SYMBOL (sym_total_cells_allocated, "total-cells-allocated"); +SCM_SYMBOL (sym_times, "gc-times"); /* Number of calls to SCM_NEWCELL since startup. */ @@ -283,33 +273,14 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, total_bytes = GC_get_total_bytes (); gc_times = GC_gc_no; - /* njrev: can any of these scm_cons's or scm_list_n signal a memory - error? If so we need a frame here. */ answer = scm_list_n (scm_cons (sym_gc_time_taken, SCM_INUM0), -#if 0 - scm_cons (sym_cells_allocated, - scm_from_ulong (local_scm_cells_allocated)), - scm_cons (sym_mallocated, - scm_from_ulong (local_scm_mallocated)), - scm_cons (sym_mtrigger, - scm_from_ulong (local_scm_mtrigger)), - scm_cons (sym_gc_mark_time_taken, - scm_from_ulong (local_scm_gc_mark_time_taken)), - scm_cons (sym_cells_marked, - scm_from_double (local_scm_gc_cells_marked)), - scm_cons (sym_cells_swept, - scm_from_double (local_scm_gc_cells_swept)), - scm_cons (sym_malloc_yield, - scm_from_long (local_scm_gc_malloc_yield_percentage)), - scm_cons (sym_cell_yield, - scm_from_long (local_scm_gc_cell_yield_percentage)), - scm_cons (sym_heap_segments, heap_segs), -#endif scm_cons (sym_heap_size, scm_from_size_t (heap_size)), scm_cons (sym_heap_free_size, scm_from_size_t (free_bytes)), scm_cons (sym_heap_total_allocated, scm_from_size_t (total_bytes)), + scm_cons (sym_heap_allocated_since_gc, + scm_from_size_t (bytes_since_gc)), scm_cons (sym_protected_objects, scm_from_ulong (protected_obj_count)), scm_cons (sym_times, scm_from_size_t (gc_times)), From bb455e4f94d8e339c9b8a69e178110cf3dfa5bcb Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 12:33:58 +0100 Subject: [PATCH 112/183] allow ,option on-error report instead of debug * module/system/repl/command.scm: * module/system/repl/debug.scm (terminal-width): Move terminal-width here, make it thread-local, and export it. (print-locals, print-frame, print-frames): Default width to terminal-width. * module/system/repl/error-handling.scm (call-with-error-handling): Add `report' and `backtrace' on-error handlers. * module/system/repl/common.scm (repl-default-options): Add on-error REPL option, defaulting to `debug', but which may be changed. * module/system/repl/repl.scm (run-repl): Pass the #:on-error REPL option to call-with-error-handling. --- module/system/repl/command.scm | 14 ------------ module/system/repl/common.scm | 9 +++++++- module/system/repl/debug.scm | 32 ++++++++++++++++++++++----- module/system/repl/error-handling.scm | 28 +++++++++++++++++++++++ module/system/repl/repl.scm | 7 ++++-- 5 files changed, 67 insertions(+), 23 deletions(-) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 685eebb0b..87ab993a5 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -71,20 +71,6 @@ (define *show-table* '((show (warranty w) (copying c) (version v)))) -(define terminal-width - (let ((set-width #f)) - (case-lambda - (() - (or set-width - (let ((w (false-if-exception (string->number (getenv "COLUMNS"))))) - (and (integer? w) (exact? w) (> w 0) w)) - 72)) - ((w) - (if (or (not w) (and (integer? w) (exact? w) (> w 0))) - (set! set-width w) - (error "Expected a column number (a positive integer)" w)))))) - - (define (group-name g) (car g)) (define (group-commands g) (cdr g)) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index 24a583ce6..a5267c616 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -121,7 +121,14 @@ See , for more details.") ,(value-history-enabled?) ,(lambda (x) (if x (enable-value-history!) (disable-value-history!)) - (->bool x)))))) + (->bool x))) + (on-error + debug + ,(let ((vals '(debug backtrace report pass))) + (lambda (x) + (if (memq x vals) + x + (error "Bad on-error value ~a; expected one of ~a" x vals)))))))) (define %make-repl make-repl) (define* (make-repl lang #:optional debug) diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm index 46ea6b4db..cf408063e 100644 --- a/module/system/repl/debug.scm +++ b/module/system/repl/debug.scm @@ -1,6 +1,6 @@ ;;; Guile VM debugging facilities -;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -32,6 +32,7 @@ #:export ( make-debug debug? debug-frames debug-index debug-error-message debug-for-trap? + terminal-width print-registers print-locals print-frame print-frames frame->module stack->vector narrow-stack->vector frame->stack-vector)) @@ -56,6 +57,25 @@ (define-record frames index error-message for-trap?) + + +;; A fluid, because terminals are usually implicitly associated with +;; threads. +;; +(define terminal-width + (let ((set-width (make-fluid))) + (case-lambda + (() + (or (fluid-ref set-width) + (let ((w (false-if-exception (string->number (getenv "COLUMNS"))))) + (and (integer? w) (exact? w) (> w 0) w)) + 72)) + ((w) + (if (or (not w) (and (integer? w) (exact? w) (> w 0))) + (fluid-set! set-width w) + (error "Expected a column number (a positive integer)" w)))))) + + (define (reverse-hashq h) @@ -79,7 +99,7 @@ (print "fp = #x~x\n" (frame-address frame))) (define* (print-locals frame #:optional (port (current-output-port)) - #:key (width 72) (per-line-prefix " ")) + #:key (width (terminal-width)) (per-line-prefix " ")) (let ((bindings (frame-bindings frame))) (cond ((null? bindings) @@ -99,8 +119,8 @@ (frame-bindings frame)))))) (define* (print-frame frame #:optional (port (current-output-port)) - #:key index (width 72) (full? #f) (last-source #f) - next-source?) + #:key index (width (terminal-width)) (full? #f) + (last-source #f) next-source?) (define (source:pretty-file source) (if source (or (source:file source) "current input") @@ -120,8 +140,8 @@ (define* (print-frames frames #:optional (port (current-output-port)) - #:key (width 72) (full? #f) (forward? #f) count - for-trap?) + #:key (width (terminal-width)) (full? #f) + (forward? #f) count for-trap?) (let* ((len (vector-length frames)) (lower-idx (if (or (not count) (positive? count)) 0 diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index d41dea643..c94db24aa 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -143,6 +143,34 @@ (format #t "Entering a new prompt. ") (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") ((@ (system repl repl) start-repl) #:debug debug)))))) + ((report) + (lambda (key . args) + (if (not (memq key pass-keys)) + (begin + (with-saved-ports + (lambda () + (run-hook before-error-hook) + (print-exception err #f key args) + (run-hook after-error-hook) + (force-output err))) + (if #f #f))))) + ((backtrace) + (lambda (key . args) + (if (not (memq key pass-keys)) + (let* ((tag (and (pair? (fluid-ref %stacks)) + (cdar (fluid-ref %stacks)))) + (frames (narrow-stack->vector + (make-stack #t) + ;; Narrow as above, for the debugging case. + 3 tag 0 (and tag 1)))) + (with-saved-ports + (lambda () + (print-frames frames) + (run-hook before-error-hook) + (print-exception err #f key args) + (run-hook after-error-hook) + (force-output err))) + (if #f #f))))) ((pass) (lambda (key . args) ;; fall through to rethrow diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 39f2319bf..5bab7780e 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -190,8 +190,10 @@ (abort-on-error "parsing expression" (repl-parse repl exp)))))) (run-hook before-eval-hook exp) - (with-error-handling - (with-stack-and-prompt thunk))) + (call-with-error-handling + (lambda () + (with-stack-and-prompt thunk)) + #:on-error (repl-option-ref repl 'on-error))) (lambda (k) (values)))) (lambda l (for-each (lambda (v) @@ -199,6 +201,7 @@ l)))) (lambda (k . args) (abort args)))) + #:on-error (repl-option-ref repl 'on-error) #:trap-handler 'disabled))) (flush-to-newline) ;; consume trailing whitespace (prompt-loop)))) From 95f5e303bc7f6174255b12fd1113d69364863762 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 18:29:08 +0100 Subject: [PATCH 113/183] scm_{to,from}_locale_string use current locale, not current ports * libguile/strings.c (scm_to_locale_stringn, scm_from_locale_stringn): Use the encoding of the current locale, not of the current i/o ports. Also use the current conversion strategy. * doc/ref/api-data.texi (Conversion to/from C): Update docs. --- doc/ref/api-data.texi | 24 ++++++++++++------------ libguile/strings.c | 36 +++--------------------------------- 2 files changed, 15 insertions(+), 45 deletions(-) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index e519cab60..0c4553f0e 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -4171,8 +4171,7 @@ using @code{scm_dynwind_free} inside an appropriate dynwind context, @deftypefn {C Function} SCM scm_from_locale_string (const char *str) @deftypefnx {C Function} SCM scm_from_locale_stringn (const char *str, size_t len) Creates a new Scheme string that has the same contents as @var{str} when -interpreted in the locale character encoding of the -@code{current-input-port}. +interpreted in the character encoding of the current locale. For @code{scm_from_locale_string}, @var{str} must be null-terminated. @@ -4201,9 +4200,9 @@ can then use @var{str} directly as its internal representation. @deftypefn {C Function} {char *} scm_to_locale_string (SCM str) @deftypefnx {C Function} {char *} scm_to_locale_stringn (SCM str, size_t *lenp) -Returns a C string with the same contents as @var{str} in the locale -encoding of the @code{current-output-port}. The C string must be freed -with @code{free} eventually, maybe by using @code{scm_dynwind_free}, +Returns a C string with the same contents as @var{str} in the character +encoding of the current locale. The C string must be freed with +@code{free} eventually, maybe by using @code{scm_dynwind_free}, @xref{Dynamic Wind}. For @code{scm_to_locale_string}, the returned string is @@ -4217,13 +4216,14 @@ returned string will not be null-terminated in this case. If @var{lenp} is @code{NULL}, @code{scm_to_locale_stringn} behaves like @code{scm_to_locale_string}. -If a character in @var{str} cannot be represented in the locale encoding -of the current output port, the port conversion strategy of the current -output port will determine the result, @xref{Ports}. If output port's -conversion strategy is @code{error}, an error will be raised. If it is -@code{substitute}, a replacement character, such as a question mark, will -be inserted in its place. If it is @code{escape}, a hex escape will be -inserted in its place. +If a character in @var{str} cannot be represented in the character +encoding of the current locale, the default port conversion strategy is +used. @xref{Ports}, for more on conversion strategies. + +If the conversion strategy is @code{error}, an error will be raised. If +it is @code{substitute}, a replacement character, such as a question +mark, will be inserted in its place. If it is @code{escape}, a hex +escape will be inserted in its place. @end deftypefn @deftypefn {C Function} size_t scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len) diff --git a/libguile/strings.c b/libguile/strings.c index b13cb780f..6f4004b3d 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1528,25 +1528,8 @@ scm_from_locale_string (const char *str) SCM scm_from_locale_stringn (const char *str, size_t len) { - const char *enc; - scm_t_string_failed_conversion_handler hndl; - SCM inport; - scm_t_port *pt; - - inport = scm_current_input_port (); - if (!SCM_UNBNDP (inport) && SCM_OPINPORTP (inport)) - { - pt = SCM_PTAB_ENTRY (inport); - enc = pt->encoding; - hndl = pt->ilseq_handler; - } - else - { - enc = NULL; - hndl = SCM_FAILED_CONVERSION_ERROR; - } - - return scm_from_stringn (str, len, enc, hndl); + return scm_from_stringn (str, len, locale_charset (), + scm_i_get_conversion_strategy (SCM_BOOL_F)); } SCM @@ -1771,21 +1754,8 @@ scm_to_locale_string (SCM str) char * scm_to_locale_stringn (SCM str, size_t *lenp) { - SCM outport; - scm_t_port *pt; - const char *enc; - - outport = scm_current_output_port (); - if (!SCM_UNBNDP (outport) && SCM_OPOUTPORTP (outport)) - { - pt = SCM_PTAB_ENTRY (outport); - enc = pt->encoding; - } - else - enc = NULL; - return scm_to_stringn (str, lenp, - enc, + locale_charset (), scm_i_get_conversion_strategy (SCM_BOOL_F)); } From f80ed1be36b9ff86291e7103488aeb06ab9c092e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 18:53:11 +0100 Subject: [PATCH 114/183] add multibyte regexp test * test-suite/standalone/Makefile.am: * test-suite/standalone/test-mb-regexp: New test, that the previous patch fixed the abort() on fixup_multibyte_match. --- test-suite/standalone/Makefile.am | 4 +++ test-suite/standalone/test-mb-regexp | 39 ++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100755 test-suite/standalone/test-mb-regexp diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index d839e2389..b21edd20d 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -143,6 +143,10 @@ TESTS += test-loose-ends check_SCRIPTS += test-fast-slot-ref TESTS += test-fast-slot-ref +# test-mb-regexp +check_SCRIPTS += test-mb-regexp +TESTS += test-mb-regexp + # test-use-srfi check_SCRIPTS += test-use-srfi TESTS += test-use-srfi diff --git a/test-suite/standalone/test-mb-regexp b/test-suite/standalone/test-mb-regexp new file mode 100755 index 000000000..b0cca69a2 --- /dev/null +++ b/test-suite/standalone/test-mb-regexp @@ -0,0 +1,39 @@ +#!/bin/sh +exec guile -q -s "$0" "$@" +!# +;;; test-mb-regexp --- A multibyte regexp test +;;; +;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;; This test depends on not setting the locale -- that multibyte strings +;; don't trigger the abort in regexp.c:fixup_multibyte_match. + +(use-modules (ice-9 regex)) + +(exit (if (equal? + (match:substring + (regexp-exec + (make-regexp "(.)(.)(.)") + (string (integer->char 200) #\x (integer->char 202))) + 2) + "x") + 0 + 1)) + +;; Local Variables: +;; mode: scheme +;; End: From c428d33d3220c96026c54075ab28021a0aeff755 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 17 Mar 2011 22:31:48 +0100 Subject: [PATCH 115/183] i18n: Re-enable tests with the Turkish locale. * test-suite/tests/i18n.test ("character mapping")["char-locale-upcase Turkish", "char-locale-downcase Turkish"]: Re-enable. Passes with GNU libc 2.12.1. ("string mapping")["string-locale-upcase Turkish", "string-locale-downcase Turkish"]: Likewise. --- test-suite/tests/i18n.test | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test index 708075e15..410ffd570 100644 --- a/test-suite/tests/i18n.test +++ b/test-suite/tests/i18n.test @@ -213,17 +213,11 @@ (pass-if "char-locale-upcase Turkish" (under-turkish-utf8-locale-or-unresolved (lambda () - ;; This test is disabled for now, because char-locale-upcase is - ;; incomplete. - (throw 'untested) (eq? #\İ (char-locale-upcase #\i %turkish-utf8-locale))))) (pass-if "char-locale-downcase Turkish" (under-turkish-utf8-locale-or-unresolved (lambda () - ;; This test is disabled for now, because char-locale-downcase - ;; is incomplete. - (throw 'untested) (eq? #\i (char-locale-downcase #\İ %turkish-utf8-locale)))))) @@ -245,17 +239,11 @@ (pass-if "string-locale-upcase Turkish" (under-turkish-utf8-locale-or-unresolved (lambda () - ;; This test is disabled for now, because string-locale-upcase - ;; is incomplete. - (throw 'untested) (string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale))))) (pass-if "string-locale-downcase Turkish" (under-turkish-utf8-locale-or-unresolved (lambda () - ;; This test is disabled for now, because - ;; string-locale-downcase is incomplete. - (throw 'untested) (string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale)))))) From e4612ff64201284167f71ac4c09ddb1959f66eb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 17 Mar 2011 22:44:25 +0100 Subject: [PATCH 116/183] i18n: Add case mapping and case-insensitive string comparison tests. Thanks to Mark H Weaver for coming up with most of the examples. * test-suite/tests/i18n.test (%german-utf8-locale-name, %greek-utf8-locale-name): New variables. (under-german-utf8-locale-or-unresolved, under-greek-utf8-locale-or-unresolved): New procedures. ("text collation (German)", "text collation (Greek)"): New tests prefixes. ("string mapping")["string-locale-upcase German", "string-locale-upcase Greek", "string-locale-upcase Greek (two sigmas)", "string-locale-downcase Greek", "string-locale-downcase Greek (two sigmas)"]: New tests. --- test-suite/tests/i18n.test | 67 +++++++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test index 410ffd570..ef715780d 100644 --- a/test-suite/tests/i18n.test +++ b/test-suite/tests/i18n.test @@ -1,6 +1,6 @@ ;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*- ;;;; -;;;; Copyright (C) 2006, 2007, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Ludovic Courtès ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -88,6 +88,12 @@ (define %turkish-utf8-locale-name "tr_TR.UTF-8") +(define %german-utf8-locale-name + "de_DE.UTF-8") + +(define %greek-utf8-locale-name + "el_GR.UTF-8") + (define %french-locale (false-if-exception (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) @@ -124,6 +130,12 @@ (define (under-turkish-utf8-locale-or-unresolved thunk) (under-locale-or-unresolved %turkish-utf8-locale thunk)) +(define (under-german-utf8-locale-or-unresolved thunk) + (under-locale-or-unresolved %german-utf8-locale-name thunk)) + +(define (under-greek-utf8-locale-or-unresolved thunk) + (under-locale-or-unresolved %greek-utf8-locale-name thunk)) + (with-test-prefix "text collation (French)" (pass-if "string-locale? #\Œ #\e %french-utf8-locale)))))) + +(with-test-prefix "text collation (German)" + + (pass-if "string-locale-ci=?" + (under-german-utf8-locale-or-unresolved + (lambda () + (let ((de (make-locale LC_ALL %german-utf8-locale-name))) + (string-locale-ci=? "Straße" "STRASSE")))))) + + +(with-test-prefix "text collation (Greek)" + + (pass-if "string-locale-ci=?" + (under-greek-utf8-locale-or-unresolved + (lambda () + (let ((gr (make-locale LC_ALL %greek-utf8-locale-name))) + (string-locale-ci=? "ΧΑΟΣ" "χαος" gr)))))) + (with-test-prefix "character mapping" @@ -236,6 +266,41 @@ (string=? "Hello, World" (string-locale-titlecase "hello, world" (make-locale LC_ALL "C"))))) + (pass-if "string-locale-upcase German" + (under-german-utf8-locale-or-unresolved + (lambda () + (let ((de (make-locale LC_ALL %german-utf8-locale-name))) + (string=? "STRASSE" + (string-locale-upcase "Straße" de)))))) + + (pass-if "string-locale-upcase Greek" + (under-greek-utf8-locale-or-unresolved + (lambda () + (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) + (string=? "ΧΑΟΣ" + (string-locale-upcase "χαος" el)))))) + + (pass-if "string-locale-upcase Greek (two sigmas)" + (under-greek-utf8-locale-or-unresolved + (lambda () + (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) + (string=? "ΓΕΙΆ ΣΑΣ" + (string-locale-upcase "Γειά σας" el)))))) + + (pass-if "string-locale-downcase Greek" + (under-greek-utf8-locale-or-unresolved + (lambda () + (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) + (string=? "χαος" + (string-locale-downcase "ΧΑΟΣ" el)))))) + + (pass-if "string-locale-downcase Greek (two sigmas)" + (under-greek-utf8-locale-or-unresolved + (lambda () + (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) + (string=? "γειά σας" + (string-locale-downcase "ΓΕΙΆ ΣΑΣ" el)))))) + (pass-if "string-locale-upcase Turkish" (under-turkish-utf8-locale-or-unresolved (lambda () From 60582b7c2a495957012f9a20cd8691dc6307a850 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 18 Mar 2011 11:24:51 +0100 Subject: [PATCH 117/183] Fix `i18n.test' when the German or Greek locales aren't available. * test-suite/tests/i18n.test (%german-utf8-locale, %greek-utf8-locale): New variables. (under-german-utf8-locale-or-unresolved, under-greek-utf8-locale-or-unresolved): Use them. --- test-suite/tests/i18n.test | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test index ef715780d..a5e418f67 100644 --- a/test-suite/tests/i18n.test +++ b/test-suite/tests/i18n.test @@ -104,6 +104,16 @@ (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) %french-utf8-locale-name))) +(define %german-utf8-locale + (false-if-exception + (make-locale LC_ALL + %german-utf8-locale-name))) + +(define %greek-utf8-locale + (false-if-exception + (make-locale LC_ALL + %greek-utf8-locale-name))) + (define %turkish-utf8-locale (false-if-exception (make-locale LC_ALL @@ -131,10 +141,10 @@ (under-locale-or-unresolved %turkish-utf8-locale thunk)) (define (under-german-utf8-locale-or-unresolved thunk) - (under-locale-or-unresolved %german-utf8-locale-name thunk)) + (under-locale-or-unresolved %german-utf8-locale thunk)) (define (under-greek-utf8-locale-or-unresolved thunk) - (under-locale-or-unresolved %greek-utf8-locale-name thunk)) + (under-locale-or-unresolved %greek-utf8-locale thunk)) (with-test-prefix "text collation (French)" From f60a7648d5926555c7760364a6fbb7dc0cf60720 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 18 Mar 2011 13:18:47 +0100 Subject: [PATCH 118/183] fix thread cleanup * libguile/threads.h: Always declare a scm_i_thread_key, for cleanup purposes, in the BUILDING_LIBGUILE case. * libguile/threads.c (scm_i_thread_key): Init with a cleanup handler, so any guile-specific info for a thread can be cleaned up reliably. (guilify_self_1): Always set the thread key. (do_thread_exit_trampoline, on_thread_exit): Enter guile-mode for the guile-mode cleanup handler, and trampoline through a gc_call_with_stack_base for reasons explained in the code. (init_thread_key, scm_i_init_thread_for_guile): Always init the key. (scm_i_with_guile_and_parent): No need for pthread_cancel cleanup handlers, as the pthread key destructor will take care of that for us. (really_launch): Remove needless pthread_exit call with incorrect comment. --- libguile/threads.c | 71 +++++++++++++++++++++++++--------------------- libguile/threads.h | 5 +++- 2 files changed, 43 insertions(+), 33 deletions(-) diff --git a/libguile/threads.c b/libguile/threads.c index e7347ad57..e2e17acc6 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -343,6 +343,12 @@ unblock_from_queue (SCM queue) /* Getting into and out of guile mode. */ +/* Key used to attach a cleanup handler to a given thread. Also, if + thread-local storage is unavailable, this key is used to retrieve the + current thread with `pthread_getspecific ()'. */ +scm_i_pthread_key_t scm_i_thread_key; + + #ifdef SCM_HAVE_THREAD_STORAGE_CLASS /* When thread-local storage (TLS) is available, a pointer to the @@ -352,17 +358,7 @@ unblock_from_queue (SCM queue) represent. */ SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread = NULL; -# define SET_CURRENT_THREAD(_t) scm_i_current_thread = (_t) - -#else /* !SCM_HAVE_THREAD_STORAGE_CLASS */ - -/* Key used to retrieve the current thread with `pthread_getspecific ()'. */ -scm_i_pthread_key_t scm_i_thread_key; - -# define SET_CURRENT_THREAD(_t) \ - scm_i_pthread_setspecific (scm_i_thread_key, (_t)) - -#endif /* !SCM_HAVE_THREAD_STORAGE_CLASS */ +#endif /* SCM_HAVE_THREAD_STORAGE_CLASS */ static scm_i_pthread_mutex_t thread_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; @@ -428,7 +424,12 @@ guilify_self_1 (SCM_STACKITEM *base) t->exited = 0; t->guile_mode = 0; - SET_CURRENT_THREAD (t); + scm_i_pthread_setspecific (scm_i_thread_key, t); + +#ifdef SCM_HAVE_THREAD_STORAGE_CLASS + /* Cache the current thread in TLS for faster lookup. */ + scm_i_current_thread = t; +#endif scm_i_pthread_mutex_lock (&thread_admin_mutex); t->next_thread = all_threads; @@ -537,6 +538,22 @@ do_thread_exit (void *v) return NULL; } +static void * +do_thread_exit_trampoline (struct GC_stack_base *sb, void *v) +{ + void *ret; + int registered; + + registered = GC_register_my_thread (sb); + + ret = scm_with_guile (do_thread_exit, v); + + if (registered == GC_SUCCESS) + GC_unregister_my_thread (); + + return ret; +} + static void on_thread_exit (void *v) { @@ -551,19 +568,20 @@ on_thread_exit (void *v) t->held_mutex = NULL; } - SET_CURRENT_THREAD (v); + /* Reinstate the current thread for purposes of scm_with_guile + guile-mode cleanup handlers. Only really needed in the non-TLS + case but it doesn't hurt to be consistent. */ + scm_i_pthread_setspecific (scm_i_thread_key, t); /* Ensure the signal handling thread has been launched, because we might be shutting it down. */ scm_i_ensure_signal_delivery_thread (); /* Unblocking the joining threads needs to happen in guile mode - since the queue is a SCM data structure. */ - - /* Note: Since `do_thread_exit ()' uses allocates memory via `libgc', we - assume the GC is usable at this point, and notably that thread-local - storage (TLS) hasn't been deallocated yet. */ - do_thread_exit (v); + since the queue is a SCM data structure. Trampoline through + GC_call_with_stack_base so that the GC works even if it already + cleaned up for this thread. */ + GC_call_with_stack_base (do_thread_exit_trampoline, v); /* Removing ourself from the list of all threads needs to happen in non-guile mode since all SCM values on our stack become @@ -590,21 +608,17 @@ on_thread_exit (void *v) scm_i_pthread_mutex_unlock (&thread_admin_mutex); - SET_CURRENT_THREAD (NULL); + scm_i_pthread_setspecific (scm_i_thread_key, NULL); } -#ifndef SCM_HAVE_THREAD_STORAGE_CLASS - static scm_i_pthread_once_t init_thread_key_once = SCM_I_PTHREAD_ONCE_INIT; static void init_thread_key (void) { - scm_i_pthread_key_create (&scm_i_thread_key, NULL); + scm_i_pthread_key_create (&scm_i_thread_key, on_thread_exit); } -#endif - /* Perform any initializations necessary to make the current thread known to Guile (via SCM_I_CURRENT_THREAD), initializing Guile itself, if necessary. @@ -625,9 +639,7 @@ init_thread_key (void) static int scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) { -#ifndef SCM_HAVE_THREAD_STORAGE_CLASS scm_i_pthread_once (&init_thread_key_once, init_thread_key); -#endif if (SCM_I_CURRENT_THREAD) { @@ -790,9 +802,7 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) /* We are in Guile mode. */ assert (t->guile_mode); - scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL); res = scm_c_with_continuation_barrier (func, data); - scm_i_pthread_cleanup_pop (0); /* Leave Guile mode. */ t->guile_mode = 0; @@ -880,9 +890,6 @@ really_launch (void *d) else t->result = scm_catch (SCM_BOOL_T, thunk, handler); - /* Trigger a call to `on_thread_exit ()'. */ - pthread_exit (NULL); - return 0; } diff --git a/libguile/threads.h b/libguile/threads.h index b5e3c2153..475af328c 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -192,6 +192,10 @@ SCM_API void scm_dynwind_critical_section (SCM mutex); #ifdef BUILDING_LIBGUILE +/* Though we don't need the key for SCM_I_CURRENT_THREAD if we have TLS, + we do use it for cleanup purposes. */ +SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key; + # ifdef SCM_HAVE_THREAD_STORAGE_CLASS SCM_INTERNAL SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread; @@ -199,7 +203,6 @@ SCM_INTERNAL SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread; # else /* !SCM_HAVE_THREAD_STORAGE_CLASS */ -SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key; # define SCM_I_CURRENT_THREAD \ ((scm_i_thread *) scm_i_pthread_getspecific (scm_i_thread_key)) From 6f2ff78299f54b1fde9f2ff85cbabf876bea85b8 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 19 Mar 2011 23:12:40 +0100 Subject: [PATCH 119/183] fix new-frame push in call/cc * libguile/vm-i-system.c (call/cc): Whoops, fix the new-frame push here. A little birdie tells me a test case is coming soon. --- libguile/vm-i-system.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 980d22afe..71c5281c8 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1179,7 +1179,7 @@ VM_DEFINE_INSTRUCTION (65, call_cc, "call/cc", 0, 1, 1) cont = scm_i_make_continuation (&first, vm, vm_cont); if (first) { - PUSH ((SCM)fp); /* dynamic link */ + PUSH (0); /* dynamic link */ PUSH (0); /* mvra */ PUSH (0); /* ra */ PUSH (proc); From d78de77f43e94c72602f3541ca672d6035607c81 Mon Sep 17 00:00:00 2001 From: Michael Gran Date: Sat, 19 Mar 2011 15:25:28 -0700 Subject: [PATCH 120/183] Benchmarks for string comparisons * benchmark-suite/benchmarks/strings.bm: new file * benchmark-suite/Makefile.am: add strings.bm --- benchmark-suite/Makefile.am | 1 + benchmark-suite/benchmarks/strings.bm | 537 ++++++++++++++++++++++++++ 2 files changed, 538 insertions(+) create mode 100644 benchmark-suite/benchmarks/strings.bm diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index 63f490cd4..d2ce6c84e 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -15,6 +15,7 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \ benchmarks/vectors.bm \ benchmarks/vlists.bm \ benchmarks/write.bm + benchmarks/strings.bm \ EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \ ChangeLog-2008 diff --git a/benchmark-suite/benchmarks/strings.bm b/benchmark-suite/benchmarks/strings.bm new file mode 100644 index 000000000..1fcdbd5a7 --- /dev/null +++ b/benchmark-suite/benchmarks/strings.bm @@ -0,0 +1,537 @@ +;;; -*- Mode: scheme; coding: utf-8; -*- +;;; strings.bm +;;; +;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;; +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this software; see the file COPYING.LESSER. If +;;; not, write to the Free Software Foundation, Inc., 51 Franklin +;;; Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (benchmarks strings) + #:use-module (benchmark-suite lib) + #:use-module (ice-9 i18n)) + +(use-modules (ice-9 i18n)) + +(seed->random-state 1) + +;; Start from a known locale state +(setlocale LC_ALL "C") + +(define char-set:cased (char-set-union char-set:lower-case + char-set:upper-case + char-set:title-case)) +(define *latin1* + (char-set->list (char-set-xor + (char-set-intersection (ucs-range->char-set 0 255) + char-set:cased) + (->char-set #\µ)))) ; Can't do a case-insensitive comparison of a string + ; with mu in fr_FR.iso88591 since it case-folds into a + ; non-Latin-1 character. + +(define *cased* + (char-set->list char-set:cased)) + +(define (random-string c-list n) + (let ((len (length c-list))) + (apply string + (map + (lambda (x) + (list-ref c-list (random len))) + (iota n))))) + +(define (diff-at-start str) + (string-append "!" (substring str 1))) +(define (diff-in-middle str) + (let ((x (floor (/ (string-length str) 2)))) + (string-append (substring str 0 x) + "!" + (substring str (1+ x))))) +(define (diff-at-end str) + (string-append (substring str 0 (1- (string-length str))) + "!")) + +(define short-latin1-string (random-string *latin1* 10)) +(define medium-latin1-string (random-string *latin1* 100)) +(define long-latin1-string (random-string *latin1* 1000)) + +(define short-latin1-string-diff-at-start (diff-at-start short-latin1-string)) +(define medium-latin1-string-diff-at-start (diff-at-start medium-latin1-string)) +(define long-latin1-string-diff-at-start (diff-at-start long-latin1-string)) + +(define short-latin1-string-diff-in-middle (diff-in-middle short-latin1-string)) +(define medium-latin1-string-diff-in-middle (diff-in-middle medium-latin1-string)) +(define long-latin1-string-diff-in-middle (diff-in-middle long-latin1-string)) + +(define short-latin1-string-diff-at-end (diff-at-end short-latin1-string)) +(define medium-latin1-string-diff-at-end (diff-at-end medium-latin1-string)) +(define long-latin1-string-diff-at-end (diff-at-end long-latin1-string)) + +(define short-cased-string (random-string *cased* 10)) +(define medium-cased-string (random-string *cased* 100)) +(define long-cased-string (random-string *cased* 1000)) + +(define short-cased-string-diff-at-start (diff-at-start short-cased-string)) +(define medium-cased-string-diff-at-start (diff-at-start medium-cased-string)) +(define long-cased-string-diff-at-start (diff-at-start long-cased-string)) + +(define short-cased-string-diff-in-middle (diff-in-middle short-cased-string)) +(define medium-cased-string-diff-in-middle (diff-in-middle medium-cased-string)) +(define long-cased-string-diff-in-middle (diff-in-middle long-cased-string)) + +(define short-cased-string-diff-at-end (diff-at-end short-cased-string)) +(define medium-cased-string-diff-at-end (diff-at-end medium-cased-string)) +(define long-cased-string-diff-at-end (diff-at-end long-cased-string)) + +(define %french-locale-name "fr_FR.ISO-8859-1") + +(define %french-utf8-locale-name "fr_FR.UTF-8") + +(define %french-locale + (false-if-exception + (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) + %french-locale-name))) + +(define %french-utf8-locale + (false-if-exception + (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) + %french-utf8-locale-name))) + +(define (under-locale-or-unresolved locale thunk) + ;; On non-GNU systems, an exception may be raised only when the locale is + ;; actually used rather than at `make-locale'-time. Thus, we must guard + ;; against both. + (if locale + (if (string-contains %host-type "-gnu") + (thunk) + (catch 'system-error thunk + (lambda (key . args) + (throw 'unresolved)))) + (throw 'unresolved))) + +(define (under-french-locale-or-unresolved thunk) + (under-locale-or-unresolved %french-locale thunk)) + +(define (under-french-utf8-locale-or-unresolved thunk) + (under-locale-or-unresolved %french-utf8-locale thunk)) + +(define (string-op str1 str2) + (string? str1 str2)) + +(define (string-ci-op str1 str2) + (string-ci? str1 str2)) + +(define (string-fr-op str1 str2) + (under-french-locale-or-unresolved + (lambda () + (string-locale? str1 str2 %french-locale)))) + +(define (string-fr-utf8-op str1 str2) + (under-french-utf8-locale-or-unresolved + (lambda () + (string-locale? str1 str2 %french-utf8-locale)))) + +(define (string-fr-ci-op str1 str2) + (under-french-locale-or-unresolved + (lambda () + (string-locale-ci? str1 str2 %french-locale)))) + +(define (string-fr-utf8-ci-op str1 str2) + (under-french-utf8-locale-or-unresolved + (lambda () + (string-locale-ci? str1 str2 %french-utf8-locale)))) + + +(with-benchmark-prefix "string ops" + + (with-benchmark-prefix "short Latin1" + + (benchmark "compare initially differing strings" 100000 + (string-op short-latin1-string short-latin1-string-diff-at-start)) + + (benchmark "compare medially differing strings" 100000 + (string-op short-latin1-string short-latin1-string-diff-in-middle)) + + (benchmark "compare terminally differing strings" 100000 + (string-op short-latin1-string short-latin1-string-diff-at-end)) + + (benchmark "compare identical strings" 100000 + (string-op short-latin1-string short-latin1-string)) + + (benchmark "case compare initially differing strings" 100000 + (string-ci-op short-latin1-string short-latin1-string-diff-at-start)) + + (benchmark "case compare medially differing strings" 100000 + (string-ci-op short-latin1-string short-latin1-string-diff-in-middle)) + + (benchmark "case compare terminally differing strings" 100000 + (string-ci-op short-latin1-string short-latin1-string-diff-at-end)) + + (benchmark "case compare identical strings" 100000 + (string-ci-op short-latin1-string short-latin1-string)) + + (benchmark "French Latin-1 locale compare initially differing strings" 100000 + (string-fr-op short-latin1-string short-latin1-string-diff-at-start)) + + (benchmark "French Latin-1 locale compare medially differing strings" 100000 + (string-fr-op short-latin1-string short-latin1-string-diff-in-middle)) + + (benchmark "French Latin-1 locale compare terminally differing strings" 100000 + (string-fr-op short-latin1-string short-latin1-string-diff-at-end)) + + (benchmark "French Latin-1 locale compare identical strings" 100000 + (string-fr-op short-latin1-string short-latin1-string)) + + (benchmark "French Latin-1 locale case compare initially differing strings" 100000 + (string-fr-ci-op short-latin1-string short-latin1-string-diff-at-start)) + + (benchmark "French Latin-1 locale case compare medially differing strings" 100000 + (string-fr-ci-op short-latin1-string short-latin1-string-diff-in-middle)) + + (benchmark "French Latin-1 locale case compare terminally differing strings" 100000 + (string-fr-ci-op short-latin1-string short-latin1-string-diff-at-end)) + + (benchmark "French Latin-1 locale case compare identical strings" 100000 + (string-fr-ci-op short-latin1-string short-latin1-string)) + + (benchmark "French UTF-8 locale compare initially differing strings" 100000 + (string-fr-utf8-op short-latin1-string short-latin1-string-diff-at-start)) + + (benchmark "French UTF-8 locale compare medially differing strings" 100000 + (string-fr-utf8-op short-latin1-string short-latin1-string-diff-in-middle)) + + (benchmark "French UTF-8 locale compare terminally differing strings" 100000 + (string-fr-utf8-op short-latin1-string short-latin1-string-diff-at-end)) + + (benchmark "French UTF-8 locale compare identical strings" 100000 + (string-fr-utf8-op short-latin1-string short-latin1-string)) + + (benchmark "French UTF-8 locale case compare initially differing strings" 100000 + (string-fr-utf8-ci-op short-latin1-string short-latin1-string-diff-at-start)) + + (benchmark "French UTF-8 locale case compare medially differing strings" 100000 + (string-fr-utf8-ci-op short-latin1-string short-latin1-string-diff-in-middle)) + + (benchmark "French UTF-8 locale case compare terminally differing strings" 100000 + (string-fr-utf8-ci-op short-latin1-string short-latin1-string-diff-at-end)) + + (benchmark "French UTF-8 locale case compare identical strings" 100000 + (string-fr-utf8-ci-op short-latin1-string short-latin1-string))) + + (with-benchmark-prefix "medium Latin1" + + (benchmark "compare initially differing strings" 10000 + (string-op medium-latin1-string medium-latin1-string-diff-at-start)) + + (benchmark "compare medially differing strings" 10000 + (string-op medium-latin1-string medium-latin1-string-diff-in-middle)) + + (benchmark "compare terminally differing strings" 10000 + (string-op medium-latin1-string medium-latin1-string-diff-at-end)) + + (benchmark "compare identical strings" 10000 + (string-op medium-latin1-string medium-latin1-string)) + + (benchmark "case compare initially differing strings" 10000 + (string-ci-op medium-latin1-string medium-latin1-string-diff-at-start)) + + (benchmark "case compare medially differing strings" 10000 + (string-ci-op medium-latin1-string medium-latin1-string-diff-in-middle)) + + (benchmark "case compare terminally differing strings" 10000 + (string-ci-op medium-latin1-string medium-latin1-string-diff-at-end)) + + (benchmark "case compare identical strings" 10000 + (string-ci-op medium-latin1-string medium-latin1-string)) + + (benchmark "French Latin-1 locale compare initially differing strings" 10000 + (string-fr-op medium-latin1-string medium-latin1-string-diff-at-start)) + + (benchmark "French Latin-1 locale compare medially differing strings" 10000 + (string-fr-op medium-latin1-string medium-latin1-string-diff-in-middle)) + + (benchmark "French Latin-1 locale compare terminally differing strings" 10000 + (string-fr-op medium-latin1-string medium-latin1-string-diff-at-end)) + + (benchmark "French Latin-1 locale compare identical strings" 10000 + (string-fr-op medium-latin1-string medium-latin1-string)) + + (benchmark "French Latin-1 locale case compare initially differing strings" 10000 + (string-fr-ci-op medium-latin1-string medium-latin1-string-diff-at-start)) + + (benchmark "French Latin-1 locale case compare medially differing strings" 10000 + (string-fr-ci-op medium-latin1-string medium-latin1-string-diff-in-middle)) + + (benchmark "French Latin-1 locale case compare terminally differing strings" 10000 + (string-fr-ci-op medium-latin1-string medium-latin1-string-diff-at-end)) + + (benchmark "French Latin-1 locale case compare identical strings" 10000 + (string-fr-ci-op medium-latin1-string medium-latin1-string)) + + (benchmark "French UTF-8 locale compare initially differing strings" 10000 + (string-fr-utf8-op medium-latin1-string medium-latin1-string-diff-at-start)) + + (benchmark "French UTF-8 locale compare medially differing strings" 10000 + (string-fr-utf8-op medium-latin1-string medium-latin1-string-diff-in-middle)) + + (benchmark "French UTF-8 locale compare terminally differing strings" 10000 + (string-fr-utf8-op medium-latin1-string medium-latin1-string-diff-at-end)) + + (benchmark "French UTF-8 locale compare identical strings" 10000 + (string-fr-utf8-op medium-latin1-string medium-latin1-string)) + + (benchmark "French UTF-8 locale case compare initially differing strings" 10000 + (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string-diff-at-start)) + + (benchmark "French UTF-8 locale case compare medially differing strings" 10000 + (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string-diff-in-middle)) + + (benchmark "French UTF-8 locale case compare terminally differing strings" 10000 + (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string-diff-at-end)) + + (benchmark "French UTF-8 locale case compare identical strings" 10000 + (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string))) + + (with-benchmark-prefix "long Latin1" + + (benchmark "compare initially differing strings" 1000 + (string-op long-latin1-string long-latin1-string-diff-at-start)) + + (benchmark "compare medially differing strings" 1000 + (string-op long-latin1-string long-latin1-string-diff-in-middle)) + + (benchmark "compare terminally differing strings" 1000 + (string-op long-latin1-string long-latin1-string-diff-at-end)) + + (benchmark "compare identical strings" 1000 + (string-op long-latin1-string long-latin1-string)) + + (benchmark "case compare initially differing strings" 1000 + (string-ci-op long-latin1-string long-latin1-string-diff-at-start)) + + (benchmark "case compare medially differing strings" 1000 + (string-ci-op long-latin1-string long-latin1-string-diff-in-middle)) + + (benchmark "case compare terminally differing strings" 1000 + (string-ci-op long-latin1-string long-latin1-string-diff-at-end)) + + (benchmark "case compare identical strings" 1000 + (string-ci-op long-latin1-string long-latin1-string)) + + (benchmark "French Latin-1 locale compare initially differing strings" 1000 + (string-fr-op long-latin1-string long-latin1-string-diff-at-start)) + + (benchmark "French Latin-1 locale compare medially differing strings" 1000 + (string-fr-op long-latin1-string long-latin1-string-diff-in-middle)) + + (benchmark "French Latin-1 locale compare terminally differing strings" 1000 + (string-fr-op long-latin1-string long-latin1-string-diff-at-end)) + + (benchmark "French Latin-1 locale compare identical strings" 1000 + (string-fr-op long-latin1-string long-latin1-string)) + + (benchmark "French Latin-1 locale case compare initially differing strings" 1000 + (string-fr-ci-op long-latin1-string long-latin1-string-diff-at-start)) + + (benchmark "French Latin-1 locale case compare medially differing strings" 1000 + (string-fr-ci-op long-latin1-string long-latin1-string-diff-in-middle)) + + (benchmark "French Latin-1 locale case compare terminally differing strings" 1000 + (string-fr-ci-op long-latin1-string long-latin1-string-diff-at-end)) + + (benchmark "French Latin-1 locale case compare identical strings" 1000 + (string-fr-ci-op long-latin1-string long-latin1-string)) + + (benchmark "French UTF-8 locale compare initially differing strings" 1000 + (string-fr-utf8-op long-latin1-string long-latin1-string-diff-at-start)) + + (benchmark "French UTF-8 locale compare medially differing strings" 1000 + (string-fr-utf8-op long-latin1-string long-latin1-string-diff-in-middle)) + + (benchmark "French UTF-8 locale compare terminally differing strings" 1000 + (string-fr-utf8-op long-latin1-string long-latin1-string-diff-at-end)) + + (benchmark "French UTF-8 locale compare identical strings" 1000 + (string-fr-utf8-op long-latin1-string long-latin1-string)) + + (benchmark "French UTF-8 locale case compare initially differing strings" 1000 + (string-fr-utf8-ci-op long-latin1-string long-latin1-string-diff-at-start)) + + (benchmark "French UTF-8 locale case compare medially differing strings" 1000 + (string-fr-utf8-ci-op long-latin1-string long-latin1-string-diff-in-middle)) + + (benchmark "French UTF-8 locale case compare terminally differing strings" 1000 + (string-fr-utf8-ci-op long-latin1-string long-latin1-string-diff-at-end)) + + (benchmark "French UTF-8 locale case compare identical strings" 1000 + (string-fr-utf8-ci-op long-latin1-string long-latin1-string))) + + (with-benchmark-prefix "short Unicode" + + (benchmark "compare initially differing strings" 100000 + (string-op short-cased-string short-cased-string-diff-at-start)) + + (benchmark "compare medially differing strings" 100000 + (string-op short-cased-string short-cased-string-diff-in-middle)) + + (benchmark "compare terminally differing strings" 100000 + (string-op short-cased-string short-cased-string-diff-at-end)) + + (benchmark "compare identical strings" 100000 + (string-op short-cased-string short-cased-string)) + + (benchmark "case compare initially differing strings" 100000 + (string-ci-op short-cased-string short-cased-string-diff-at-start)) + + (benchmark "case compare medially differing strings" 100000 + (string-ci-op short-cased-string short-cased-string-diff-in-middle)) + + (benchmark "case compare terminally differing strings" 100000 + (string-ci-op short-cased-string short-cased-string-diff-at-end)) + + (benchmark "case compare identical strings" 100000 + (string-ci-op short-cased-string short-cased-string)) + + (benchmark "French UTF-8 locale compare initially differing strings" 100000 + (string-fr-utf8-op short-cased-string short-cased-string-diff-at-start)) + + (benchmark "French UTF-8 locale compare medially differing strings" 100000 + (string-fr-utf8-op short-cased-string short-cased-string-diff-in-middle)) + + (benchmark "French UTF-8 locale compare terminally differing strings" 100000 + (string-fr-utf8-op short-cased-string short-cased-string-diff-at-end)) + + (benchmark "French UTF-8 locale compare identical strings" 100000 + (string-fr-utf8-op short-cased-string short-cased-string)) + + (benchmark "French UTF-8 locale case compare initially differing strings" 100000 + (string-fr-utf8-ci-op short-cased-string short-cased-string-diff-at-start)) + + (benchmark "French UTF-8 locale case compare medially differing strings" 100000 + (string-fr-utf8-ci-op short-cased-string short-cased-string-diff-in-middle)) + + (benchmark "French UTF-8 locale case compare terminally differing strings" 100000 + (string-fr-utf8-ci-op short-cased-string short-cased-string-diff-at-end)) + + (benchmark "French UTF-8 locale case compare identical strings" 100000 + (string-fr-utf8-ci-op short-cased-string short-cased-string))) + + (with-benchmark-prefix "medium Unicode" + + (benchmark "compare initially differing strings" 10000 + (string-op medium-cased-string medium-cased-string-diff-at-start)) + + (benchmark "compare medially differing strings" 10000 + (string-op medium-cased-string medium-cased-string-diff-in-middle)) + + (benchmark "compare terminally differing strings" 10000 + (string-op medium-cased-string medium-cased-string-diff-at-end)) + + (benchmark "compare identical strings" 10000 + (string-op medium-cased-string medium-cased-string)) + + (benchmark "case compare initially differing strings" 10000 + (string-ci-op medium-cased-string medium-cased-string-diff-at-start)) + + (benchmark "case compare medially differing strings" 10000 + (string-ci-op medium-cased-string medium-cased-string-diff-in-middle)) + + (benchmark "case compare terminally differing strings" 10000 + (string-ci-op medium-cased-string medium-cased-string-diff-at-end)) + + (benchmark "case compare identical strings" 10000 + (string-ci-op medium-cased-string medium-cased-string)) + + (benchmark "French UTF-8 locale compare initially differing strings" 10000 + (string-fr-utf8-op medium-cased-string medium-cased-string-diff-at-start)) + + (benchmark "French UTF-8 locale compare medially differing strings" 10000 + (string-fr-utf8-op medium-cased-string medium-cased-string-diff-in-middle)) + + (benchmark "French UTF-8 locale compare terminally differing strings" 10000 + (string-fr-utf8-op medium-cased-string medium-cased-string-diff-at-end)) + + (benchmark "French UTF-8 locale compare identical strings" 10000 + (string-fr-utf8-op medium-cased-string medium-cased-string)) + + (benchmark "French UTF-8 locale case compare initially differing strings" 10000 + (string-fr-utf8-ci-op medium-cased-string medium-cased-string-diff-at-start)) + + (benchmark "French UTF-8 locale case compare medially differing strings" 10000 + (string-fr-utf8-ci-op medium-cased-string medium-cased-string-diff-in-middle)) + + (benchmark "French UTF-8 locale case compare terminally differing strings" 10000 + (string-fr-utf8-ci-op medium-cased-string medium-cased-string-diff-at-end)) + + (benchmark "French UTF-8 locale case compare identical strings" 10000 + (string-fr-utf8-ci-op medium-cased-string medium-cased-string))) + + (with-benchmark-prefix "long Unicode" + + (benchmark "compare initially differing strings" 1000 + (string-op long-cased-string long-cased-string-diff-at-start)) + + (benchmark "compare medially differing strings" 1000 + (string-op long-cased-string long-cased-string-diff-in-middle)) + + (benchmark "compare terminally differing strings" 1000 + (string-op long-cased-string long-cased-string-diff-at-end)) + + (benchmark "compare identical strings" 1000 + (string-op long-cased-string long-cased-string)) + + (benchmark "case compare initially differing strings" 1000 + (string-ci-op long-cased-string long-cased-string-diff-at-start)) + + (benchmark "case compare medially differing strings" 1000 + (string-ci-op long-cased-string long-cased-string-diff-in-middle)) + + (benchmark "case compare terminally differing strings" 1000 + (string-ci-op long-cased-string long-cased-string-diff-at-end)) + + (benchmark "case compare identical strings" 1000 + (string-ci-op long-cased-string long-cased-string)) + + (benchmark "French UTF-8 locale compare initially differing strings" 1000 + (string-fr-utf8-op long-cased-string long-cased-string-diff-at-start)) + + (benchmark "French UTF-8 locale compare medially differing strings" 1000 + (string-fr-utf8-op long-cased-string long-cased-string-diff-in-middle)) + + (benchmark "French UTF-8 locale compare terminally differing strings" 1000 + (string-fr-utf8-op long-cased-string long-cased-string-diff-at-end)) + + (benchmark "French UTF-8 locale compare identical strings" 1000 + (string-fr-utf8-op long-cased-string long-cased-string)) + + (benchmark "French UTF-8 locale case compare initially differing strings" 1000 + (string-fr-utf8-ci-op long-cased-string long-cased-string-diff-at-start)) + + (benchmark "French UTF-8 locale case compare medially differing strings" 1000 + (string-fr-utf8-ci-op long-cased-string long-cased-string-diff-in-middle)) + + (benchmark "French UTF-8 locale case compare terminally differing strings" 1000 + (string-fr-utf8-ci-op long-cased-string long-cased-string-diff-at-end)) + + (benchmark "French UTF-8 locale case compare identical strings" 1000 + (string-fr-utf8-ci-op long-cased-string long-cased-string)))) + + From 75847d5767df6321adcd47e92d1a986333d4e9bd Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sun, 20 Mar 2011 00:49:07 +0100 Subject: [PATCH 121/183] Fix syntax error in benchmark-suite/Makefile.am * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Correct position of a trailing backslash. --- benchmark-suite/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index d2ce6c84e..bac1df396 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -14,8 +14,8 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \ benchmarks/uniform-vector-read.bm \ benchmarks/vectors.bm \ benchmarks/vlists.bm \ - benchmarks/write.bm - benchmarks/strings.bm \ + benchmarks/write.bm \ + benchmarks/strings.bm EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \ ChangeLog-2008 From 13f1461c2417cc80f050beb4c11a94deb60defae Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sun, 20 Mar 2011 01:00:09 +0100 Subject: [PATCH 122/183] Add VM test for call/cc in non-tail position * test-suite/vm/t-call-cc.scm: Add test case using call/cc in a non-tail position. --- test-suite/vm/t-call-cc.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/test-suite/vm/t-call-cc.scm b/test-suite/vm/t-call-cc.scm index 05e4de98c..097f276ff 100644 --- a/test-suite/vm/t-call-cc.scm +++ b/test-suite/vm/t-call-cc.scm @@ -14,3 +14,17 @@ (else (set-counter2 (1+ counter2)))))) (loop 0)) + +(let* ((next #f) + (counter 0) + (result (call/cc + (lambda (k) + (set! next k) + 1)))) + (set! counter (+ 1 counter)) + (cond ((not (= counter result)) + (error "bad call/cc behaviour" counter result)) + ((> counter 10) + #t) + (else + (next (+ 1 counter))))) From 95c1cfb550e2e753324c5cc57ef5df90034f072a Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Sat, 19 Mar 2011 23:21:06 -0400 Subject: [PATCH 123/183] fix guile-snarf * libguile/snarf.h: New macro `SCM_SNARF_INIT_PREFIX'. (SCM_SNARF_INIT) Use `SCM_SNARF_INIT_PREFIX' instead of including a literal marker. If the preprocessor echoes #define directives to its output, this will prevent `guile-snarf' from snarfing the `SCM_SNARF_INIT' definition itself. Reported by Mike Gran . * libguile/guile-snarf.in (modern_snarf): Don't output anything for lines in which only one of the magic snarfing markers is present. Modify the `sed' program for compatibility with POSIX `sed'. The new `sed' program is based on a version by Wolfgang Jenkner . * test-suite/standalone/test-guile-snarf: New tests. --- libguile/guile-snarf.in | 15 ++++++++++++++- libguile/snarf.h | 8 +++++++- test-suite/standalone/test-guile-snarf | 2 ++ 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index a1aeba577..c73e8ce1e 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -51,7 +51,20 @@ modern_snarf () # writes stdout ## empty file. echo "/* cpp arguments: $@ */" ; ${cpp} -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp} && cpp_ok_p=true - sed -ne "s/ *\^ *: *\^/\n/;s/[^\n]*\^ *\^ *\([^\n]*\)/\1;/;tx;d;:x;P;D" ${temp} + sed -ne 's/ *\^ *: *\^/\ +/ +h +s/\n.*// +t x +d +: x +s/.*\^ *\^ *\(.*\)/\1;/ +t y +d +: y +p +x +D' ${temp} } ## main diff --git a/libguile/snarf.h b/libguile/snarf.h index 9bb998eb0..7d22a3617 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -53,11 +53,17 @@ * The SCM_SNARF_INIT text goes into the corresponding .x file * up through the first occurrence of SCM_SNARF_DOC_START on that * line, if any. + * + * Some debugging options can cause the preprocessor to echo #define + * directives to its output. Keeping the snarfing markers on separate + * lines prevents guile-snarf from inadvertently snarfing the definition + * of SCM_SNARF_INIT if those options are in effect. */ #ifdef SCM_MAGIC_SNARF_INITS # define SCM_SNARF_HERE(X) -# define SCM_SNARF_INIT(X) ^^ X ^:^ +# define SCM_SNARF_INIT_PREFIX ^^ +# define SCM_SNARF_INIT(X) SCM_SNARF_INIT_PREFIX X ^:^ # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) #else # ifdef SCM_MAGIC_SNARF_DOCS diff --git a/test-suite/standalone/test-guile-snarf b/test-suite/standalone/test-guile-snarf index 78d35ea16..41a9dc64a 100755 --- a/test-suite/standalone/test-guile-snarf +++ b/test-suite/standalone/test-guile-snarf @@ -18,3 +18,5 @@ snarf_test " ^ ^ b ^ : ^ " "b;" snarf_test "c\n^^d^:^\ne" "d;" snarf_test "f^^g^:^h" "g;" snarf_test "^^i^:^j^^k^:^" "i;k;" +snarf_test "l^^m" "" +snarf_test "n^:^o" "" From 190d4b0d93599e5b58e773dc6375054c3a6e3dbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 20 Mar 2011 23:34:42 +0100 Subject: [PATCH 124/183] Make VM string literals immutable. * libguile/strings.c (scm_i_make_string, scm_i_make_wide_string): Add `read_only_p' parameter. All callers updated. * libguile/vm-i-loader.c (load_string, load_wide_string): Push read-only strings. * test-suite/tests/strings.test ("literals"): New test prefix. --- libguile/deprecated.c | 2 +- libguile/goops.c | 2 +- libguile/i18n.c | 2 +- libguile/ports.c | 2 +- libguile/read.c | 8 +++--- libguile/socket.c | 2 +- libguile/srfi-13.c | 26 +++++++++--------- libguile/srfi-14.c | 4 +-- libguile/strings.c | 50 +++++++++++++++++++---------------- libguile/strings.h | 7 +++-- libguile/strports.c | 2 +- libguile/vm-i-loader.c | 4 +-- test-suite/tests/strings.test | 28 +++++++++++++++++--- 13 files changed, 83 insertions(+), 56 deletions(-) diff --git a/libguile/deprecated.c b/libguile/deprecated.c index fd23e2dc9..4d6027c35 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2281,7 +2281,7 @@ scm_allocate_string (size_t len) { scm_c_issue_deprecation_warning ("`scm_allocate_string' is deprecated. Use scm_c_make_string instead."); - return scm_i_make_string (len, NULL); + return scm_i_make_string (len, NULL, 0); } SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0, diff --git a/libguile/goops.c b/libguile/goops.c index c597044f5..f6102085f 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -670,7 +670,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, SCM_MISC_ERROR ("class object doesn't have enough fields: ~S", scm_list_1 (nfields)); - layout = scm_i_make_string (n, &s); + layout = scm_i_make_string (n, &s, 0); i = 0; while (scm_is_pair (getters_n_setters)) { diff --git a/libguile/i18n.c b/libguile/i18n.c index da3c220de..51bbc2f04 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1252,7 +1252,7 @@ str_to_case (SCM str, scm_t_locale c_locale, return NULL; } - convstr = scm_i_make_wide_string (convlen, &c_buf); + convstr = scm_i_make_wide_string (convlen, &c_buf, 0); memcpy (c_buf, c_convstr, convlen * sizeof (scm_t_wchar)); free (c_convstr); diff --git a/libguile/ports.c b/libguile/ports.c index 8f52e66f1..6e0ae6c8b 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -352,7 +352,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0, if (count) { - result = scm_i_make_string (count, &data); + result = scm_i_make_string (count, &data, 0); scm_take_from_input_buffers (port, data, count); } else diff --git a/libguile/read.c b/libguile/read.c index a889133a7..e0f3cf815 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -516,7 +516,7 @@ scm_read_string (int chr, SCM port) unsigned c_str_len = 0; scm_t_wchar c; - str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL); + str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0); while ('"' != (c = scm_getc (port))) { if (c == EOF) @@ -528,7 +528,7 @@ scm_read_string (int chr, SCM port) if (c_str_len + 1 >= scm_i_string_length (str)) { - SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL); + SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0); str = scm_string_append (scm_list_2 (str, addy)); } @@ -1232,7 +1232,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) So here, CHR is expected to be `{'. */ int saw_brace = 0, finished = 0; size_t len = 0; - SCM buf = scm_i_make_string (1024, NULL); + SCM buf = scm_i_make_string (1024, NULL, 0); buf = scm_i_string_start_writing (buf); @@ -1262,7 +1262,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) SCM addy; scm_i_string_stop_writing (); - addy = scm_i_make_string (1024, NULL); + addy = scm_i_make_string (1024, NULL, 0); buf = scm_string_append (scm_list_2 (buf, addy)); len = 0; buf = scm_i_string_start_writing (buf); diff --git a/libguile/socket.c b/libguile/socket.c index 10597081d..632dd4f40 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -1426,7 +1426,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0, "use a bytevector instead."); len = scm_i_string_length (buf); - msg = scm_i_make_string (len, &dest); + msg = scm_i_make_string (len, &dest, 0); SCM_SYSCALL (rv = recv (fd, dest, len, flg)); scm_string_copy_x (buf, scm_from_int (0), msg, scm_from_int (0), scm_from_size_t (len)); diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index 06d7f3b55..5bba81c7f 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -251,14 +251,14 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0, if (wide) { scm_t_wchar *wbuf = NULL; - res = scm_i_make_wide_string (clen, &wbuf); + res = scm_i_make_wide_string (clen, &wbuf, 0); memcpy (wbuf, buf, clen * sizeof (scm_t_wchar)); free (buf); } else { char *nbuf = NULL; - res = scm_i_make_string (clen, &nbuf); + res = scm_i_make_string (clen, &nbuf, 0); for (i = 0; i < clen; i ++) nbuf[i] = (unsigned char) buf[i]; free (buf); @@ -336,7 +336,7 @@ SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0, if (i < 0) SCM_WRONG_TYPE_ARG (1, chrs); - result = scm_i_make_string (i, &data); + result = scm_i_make_string (i, &data, 0); { SCM rest; @@ -439,7 +439,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0, SCM_MISC_ERROR ("strict-infix grammar requires non-empty list", SCM_EOL); - result = scm_i_make_string (0, NULL); + result = scm_i_make_string (0, NULL, 0); tmp = ls; switch (gram) @@ -2486,7 +2486,7 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0, MY_VALIDATE_SUBSTRING_SPEC (2, s, 3, start, cstart, 4, end, cend); - result = scm_i_make_string (cend - cstart, NULL); + result = scm_i_make_string (cend - cstart, NULL, 0); p = 0; while (cstart < cend) { @@ -2624,7 +2624,7 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0, ans = base; } else - ans = scm_i_make_string (0, NULL); + ans = scm_i_make_string (0, NULL, 0); if (!SCM_UNBNDP (make_final)) SCM_VALIDATE_PROC (6, make_final); @@ -2636,7 +2636,7 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0, SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f)); - str = scm_i_make_string (1, NULL); + str = scm_i_make_string (1, NULL, 0); str = scm_i_string_start_writing (str); scm_i_string_set_x (str, i, SCM_CHAR (ch)); scm_i_string_stop_writing (); @@ -2690,7 +2690,7 @@ SCM_DEFINE (scm_string_unfold_right, "string-unfold-right", 4, 2, 0, ans = base; } else - ans = scm_i_make_string (0, NULL); + ans = scm_i_make_string (0, NULL, 0); if (!SCM_UNBNDP (make_final)) SCM_VALIDATE_PROC (6, make_final); @@ -2702,7 +2702,7 @@ SCM_DEFINE (scm_string_unfold_right, "string-unfold-right", 4, 2, 0, SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f)); - str = scm_i_make_string (1, NULL); + str = scm_i_make_string (1, NULL, 0); str = scm_i_string_start_writing (str); scm_i_string_set_x (str, i, SCM_CHAR (ch)); scm_i_string_stop_writing (); @@ -2817,7 +2817,7 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0, if (cstart == cend && cfrom != cto) SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL); - result = scm_i_make_string (cto - cfrom, NULL); + result = scm_i_make_string (cto - cfrom, NULL, 0); result = scm_i_string_start_writing (result); p = 0; @@ -3129,7 +3129,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0, else { size_t dst = 0; - result = scm_i_make_string (count, NULL); + result = scm_i_make_string (count, NULL, 0); result = scm_i_string_start_writing (result); /* decrement "count" in this loop as well as using idx, so that if @@ -3239,7 +3239,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0, { int i = 0; /* new string for retained portion */ - result = scm_i_make_string (count, NULL); + result = scm_i_make_string (count, NULL, 0); result = scm_i_string_start_writing (result); /* decrement "count" in this loop as well as using idx, so that if another thread is simultaneously changing "s" there's no chance @@ -3281,7 +3281,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0, { size_t i = 0; /* new string for retained portion */ - result = scm_i_make_string (count, NULL); + result = scm_i_make_string (count, NULL, 0); result = scm_i_string_start_writing (result); /* decrement "count" in this loop as well as using idx, so that if diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c index b22471de4..e2f66681a 100644 --- a/libguile/srfi-14.c +++ b/libguile/srfi-14.c @@ -1515,9 +1515,9 @@ SCM_DEFINE (scm_char_set_to_string, "char-set->string", 1, 0, 0, count = scm_to_int (scm_char_set_size (cs)); if (wide) - result = scm_i_make_wide_string (count, &wbuf); + result = scm_i_make_wide_string (count, &wbuf, 0); else - result = scm_i_make_string (count, &buf); + result = scm_i_make_string (count, &buf, 0); for (k = 0; k < cs_data->len; k++) for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++) diff --git a/libguile/strings.c b/libguile/strings.c index 6f4004b3d..cdf81410d 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -262,30 +262,34 @@ SCM scm_nullstr; /* Create a scheme string with space for LEN 8-bit Latin-1-encoded characters. CHARSP, if not NULL, will be set to location of the - char array. */ + char array. If READ_ONLY_P, the returned string is read-only; + otherwise it is writable. */ SCM -scm_i_make_string (size_t len, char **charsp) +scm_i_make_string (size_t len, char **charsp, int read_only_p) { SCM buf = make_stringbuf (len); SCM res; if (charsp) *charsp = (char *) STRINGBUF_CHARS (buf); - res = scm_double_cell (STRING_TAG, SCM_UNPACK(buf), - (scm_t_bits)0, (scm_t_bits) len); + res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG, + SCM_UNPACK (buf), + (scm_t_bits) 0, (scm_t_bits) len); return res; } /* Create a scheme string with space for LEN 32-bit UCS-4-encoded characters. CHARSP, if not NULL, will be set to location of the - character array. */ + character array. If READ_ONLY_P, the returned string is read-only; + otherwise it is writable. */ SCM -scm_i_make_wide_string (size_t len, scm_t_wchar **charsp) +scm_i_make_wide_string (size_t len, scm_t_wchar **charsp, int read_only_p) { SCM buf = make_wide_stringbuf (len); SCM res; if (charsp) *charsp = STRINGBUF_WIDE_CHARS (buf); - res = scm_double_cell (STRING_TAG, SCM_UNPACK (buf), + res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG, + SCM_UNPACK (buf), (scm_t_bits) 0, (scm_t_bits) len); return res; } @@ -889,7 +893,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str), { size_t len = STRINGBUF_LENGTH (buf); char *cbuf; - SCM sbc = scm_i_make_string (len, &cbuf); + SCM sbc = scm_i_make_string (len, &cbuf, 0); memcpy (cbuf, STRINGBUF_CHARS (buf), len); e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"), sbc); @@ -898,7 +902,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str), { size_t len = STRINGBUF_LENGTH (buf); scm_t_wchar *cbuf; - SCM sbc = scm_i_make_wide_string (len, &cbuf); + SCM sbc = scm_i_make_wide_string (len, &cbuf, 0); u32_cpy ((scm_t_uint32 *) cbuf, (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len); e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"), @@ -962,7 +966,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym), { size_t len = STRINGBUF_LENGTH (buf); char *cbuf; - SCM sbc = scm_i_make_string (len, &cbuf); + SCM sbc = scm_i_make_string (len, &cbuf, 0); memcpy (cbuf, STRINGBUF_CHARS (buf), len); e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"), sbc); @@ -971,7 +975,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym), { size_t len = STRINGBUF_LENGTH (buf); scm_t_wchar *cbuf; - SCM sbc = scm_i_make_wide_string (len, &cbuf); + SCM sbc = scm_i_make_wide_string (len, &cbuf, 0); u32_cpy ((scm_t_uint32 *) cbuf, (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len); e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"), @@ -1066,7 +1070,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, { char *buf; - result = scm_i_make_string (len, NULL); + result = scm_i_make_string (len, NULL, 0); result = scm_i_string_start_writing (result); buf = scm_i_string_writable_chars (result); while (len > 0 && scm_is_pair (rest)) @@ -1083,7 +1087,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, { scm_t_wchar *buf; - result = scm_i_make_wide_string (len, NULL); + result = scm_i_make_wide_string (len, NULL, 0); result = scm_i_string_start_writing (result); buf = scm_i_string_writable_wide_chars (result); while (len > 0 && scm_is_pair (rest)) @@ -1125,7 +1129,7 @@ scm_c_make_string (size_t len, SCM chr) { size_t p; char *contents = NULL; - SCM res = scm_i_make_string (len, &contents); + SCM res = scm_i_make_string (len, &contents, 0); /* If no char is given, initialize string contents to NULL. */ if (SCM_UNBNDP (chr)) @@ -1372,9 +1376,9 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, } data.narrow = NULL; if (!wide) - res = scm_i_make_string (len, &data.narrow); + res = scm_i_make_string (len, &data.narrow, 0); else - res = scm_i_make_wide_string (len, &data.wide); + res = scm_i_make_wide_string (len, &data.wide, 0); for (l = args; !scm_is_null (l); l = SCM_CDR (l)) { @@ -1463,7 +1467,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, { /* If encoding is null, use Latin-1. */ char *buf; - res = scm_i_make_string (len, &buf); + res = scm_i_make_string (len, &buf, 0); memcpy (buf, str, len); return res; } @@ -1502,7 +1506,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, if (!wide) { char *dst; - res = scm_i_make_string (u32len, &dst); + res = scm_i_make_string (u32len, &dst, 0); for (i = 0; i < u32len; i ++) dst[i] = (unsigned char) u32[i]; dst[u32len] = '\0'; @@ -1510,7 +1514,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, else { scm_t_wchar *wdst; - res = scm_i_make_wide_string (u32len, &wdst); + res = scm_i_make_wide_string (u32len, &wdst, 0); u32_cpy ((scm_t_uint32 *) wdst, (scm_t_uint32 *) u32, u32len); wdst[u32len] = 0; } @@ -1548,7 +1552,7 @@ scm_from_latin1_stringn (const char *str, size_t len) len = strlen (str); /* Make a narrow string and copy STR as is. */ - result = scm_i_make_string (len, &buf); + result = scm_i_make_string (len, &buf, 0); memcpy (buf, str, len); return result; @@ -1581,7 +1585,7 @@ scm_from_utf32_stringn (const scm_t_wchar *str, size_t len) if (len == (size_t) -1) len = u32_strlen ((uint32_t *) str); - result = scm_i_make_wide_string (len, &buf); + result = scm_i_make_wide_string (len, &buf, 0); memcpy (buf, str, len * sizeof (scm_t_wchar)); scm_i_try_narrow_string (result); @@ -1999,7 +2003,7 @@ normalize_str (SCM string, uninorm_t form) w_str = u32_normalize (form, w_str, len, NULL, &rlen); - ret = scm_i_make_wide_string (rlen, &cbuf); + ret = scm_i_make_wide_string (rlen, &cbuf, 0); u32_cpy ((scm_t_uint32 *) cbuf, w_str, rlen); free (w_str); @@ -2211,7 +2215,7 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string) void scm_init_strings () { - scm_nullstr = scm_i_make_string (0, NULL); + scm_nullstr = scm_i_make_string (0, NULL, 1); #include "libguile/strings.x" } diff --git a/libguile/strings.h b/libguile/strings.h index ed3a067c2..b1fc51a38 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -177,8 +177,11 @@ SCM_API SCM scm_makfromstrs (int argc, char **argv); /* internal accessor functions. Arguments must be valid. */ -SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap); -SCM_INTERNAL SCM scm_i_make_wide_string (size_t len, scm_t_wchar **datap); +SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap, + int read_only_p); +SCM_INTERNAL SCM scm_i_make_wide_string (size_t len, scm_t_wchar **datap, + int read_only_p); +SCM_INTERNAL SCM scm_i_set_string_read_only_x (SCM str); SCM_INTERNAL SCM scm_i_substring (SCM str, size_t start, size_t end); SCM_INTERNAL SCM scm_i_substring_read_only (SCM str, size_t start, size_t end); SCM_INTERNAL SCM scm_i_substring_shared (SCM str, size_t start, size_t end); diff --git a/libguile/strports.c b/libguile/strports.c index 594d03011..b7fec4703 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -357,7 +357,7 @@ scm_strport_to_string (SCM port) if (pt->encoding == NULL) { char *buf; - str = scm_i_make_string (pt->read_buf_size, &buf); + str = scm_i_make_string (pt->read_buf_size, &buf, 0); memcpy (buf, pt->read_buf, pt->read_buf_size); } else diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c index fae39fb8d..0d8678485 100644 --- a/libguile/vm-i-loader.c +++ b/libguile/vm-i-loader.c @@ -40,7 +40,7 @@ VM_DEFINE_LOADER (102, load_string, "load-string") FETCH_LENGTH (len); SYNC_REGISTER (); - PUSH (scm_i_make_string (len, &buf)); + PUSH (scm_i_make_string (len, &buf, 1)); memcpy (buf, (char *) ip, len); ip += len; NEXT; @@ -113,7 +113,7 @@ VM_DEFINE_LOADER (107, load_wide_string, "load-wide-string") } SYNC_REGISTER (); - PUSH (scm_i_make_wide_string (len / 4, &wbuf)); + PUSH (scm_i_make_wide_string (len / 4, &wbuf, 1)); memcpy ((char *) wbuf, (char *) ip, len); ip += len; NEXT; diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test index fa8e6e1af..d892b7077 100644 --- a/test-suite/tests/strings.test +++ b/test-suite/tests/strings.test @@ -1,23 +1,25 @@ ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- ;;;; Jim Blandy --- August 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009, 2010, +;;;; 2011 Free Software Foundation, Inc. +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-strings) + #:use-module ((system base compile) #:select (compile)) #:use-module (test-suite lib)) (define exception:read-only-string @@ -240,6 +242,24 @@ (pass-if "symbol" (not (string? 'abc)))) +;; +;; literals +;; + +(with-test-prefix "literals" + + ;; The "Storage Model" section of R5RS reads: "In such systems literal + ;; constants and the strings returned by `symbol->string' are + ;; immutable objects". `eval' doesn't support it yet, but it doesn't + ;; really matter because `eval' doesn't coalesce repeated constants, + ;; unlike the bytecode compiler. + + (pass-if-exception "literals are constant" + exception:read-only-string + (compile '(string-set! "literal string" 0 #\x) + #:from 'scheme + #:to 'value))) + ;; ;; string-null? ;; From 8099352769c8b8ec8730f87f7fa6c8771b64efb9 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 22 Mar 2011 11:11:53 -0400 Subject: [PATCH 125/183] Do not enter the debugger if the thrown key is in `pass-keys' * module/system/repl/error-handling.scm (call-with-error-handling): Do _not_ enter the debugger if the thrown key is in `pass-keys'. Previously, for example, (throw 'quit) entered the debugger when run from the REPL, despite the fact that 'quit is in `pass-keys'. --- module/system/repl/error-handling.scm | 43 ++++++++++++++------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index c94db24aa..c6c64cc73 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -122,27 +122,28 @@ (case on-error ((debug) (lambda (key . args) - (let* ((tag (and (pair? (fluid-ref %stacks)) - (cdar (fluid-ref %stacks)))) - (stack (narrow-stack->vector - (make-stack #t) - ;; Cut three frames from the top of the stack: - ;; make-stack, this one, and the throw handler. - 3 - ;; Narrow the end of the stack to the most recent - ;; start-stack. - tag - ;; And one more frame, because %start-stack invoking - ;; the start-stack thunk has its own frame too. - 0 (and tag 1))) - (error-msg (error-string stack key args)) - (debug (make-debug stack 0 error-msg #f))) - (with-saved-ports - (lambda () - (format #t "~a~%" error-msg) - (format #t "Entering a new prompt. ") - (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") - ((@ (system repl repl) start-repl) #:debug debug)))))) + (if (not (memq key pass-keys)) + (let* ((tag (and (pair? (fluid-ref %stacks)) + (cdar (fluid-ref %stacks)))) + (stack (narrow-stack->vector + (make-stack #t) + ;; Cut three frames from the top of the stack: + ;; make-stack, this one, and the throw handler. + 3 + ;; Narrow the end of the stack to the most recent + ;; start-stack. + tag + ;; And one more frame, because %start-stack invoking + ;; the start-stack thunk has its own frame too. + 0 (and tag 1))) + (error-msg (error-string stack key args)) + (debug (make-debug stack 0 error-msg #f))) + (with-saved-ports + (lambda () + (format #t "~a~%" error-msg) + (format #t "Entering a new prompt. ") + (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") + ((@ (system repl repl) start-repl) #:debug debug))))))) ((report) (lambda (key . args) (if (not (memq key pass-keys)) From ad301b6d58c2ca054ebe1fdfaf7357e61311a977 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 23 Mar 2011 17:05:28 +0100 Subject: [PATCH 126/183] fix a failure to sync regs in vm bytevector ops * libguile/vm-i-scheme.c (BV_SET_WITH_ENDIANNESS, BV_FIXABLE_INT_SET) (BV_INT_SET, BV_FLOAT_SET): Sync registers before dispatching to the C function. --- libguile/vm-i-scheme.c | 54 +++++++++++++++++++++++++----------------- 1 file changed, 32 insertions(+), 22 deletions(-) diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c index 19b48c59e..9e249bc85 100644 --- a/libguile/vm-i-scheme.c +++ b/libguile/vm-i-scheme.c @@ -821,6 +821,7 @@ BV_FLOAT_REF (f64, ieee_double, double, 8) goto VM_LABEL (bv_##stem##_native_set); \ { \ SCM bv, idx, val; POP (val); POP (idx); POP (bv); \ + SYNC_REGISTER (); \ scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \ NEXT; \ } \ @@ -865,7 +866,10 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double) && (j <= max))) \ *int_ptr = (scm_t_ ## type) j; \ else \ - scm_bytevector_ ## fn_stem ## _set_x (bv, idx, val); \ + { \ + SYNC_REGISTER (); \ + scm_bytevector_ ## fn_stem ## _set_x (bv, idx, val); \ + } \ NEXT; \ } @@ -886,29 +890,35 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double) && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \ *int_ptr = scm_to_ ## type (val); \ else \ - scm_bytevector_ ## stem ## _native_set_x (bv, idx, val); \ - NEXT; \ + { \ + SYNC_REGISTER (); \ + scm_bytevector_ ## stem ## _native_set_x (bv, idx, val); \ + } \ + NEXT; \ } -#define BV_FLOAT_SET(stem, fn_stem, type, size) \ -{ \ - scm_t_signed_bits i = 0; \ - SCM bv, idx, val; \ - type *float_ptr; \ - \ - POP (val); POP (idx); POP (bv); \ - VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \ - i = SCM_I_INUM (idx); \ - float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \ - \ - if (SCM_LIKELY (SCM_I_INUMP (idx) \ - && (i >= 0) \ - && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \ - && (ALIGNED_P (float_ptr, type)))) \ - *float_ptr = scm_to_double (val); \ - else \ - scm_bytevector_ ## fn_stem ## _native_set_x (bv, idx, val); \ - NEXT; \ +#define BV_FLOAT_SET(stem, fn_stem, type, size) \ +{ \ + scm_t_signed_bits i = 0; \ + SCM bv, idx, val; \ + type *float_ptr; \ + \ + POP (val); POP (idx); POP (bv); \ + VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \ + i = SCM_I_INUM (idx); \ + float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \ + \ + if (SCM_LIKELY (SCM_I_INUMP (idx) \ + && (i >= 0) \ + && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \ + && (ALIGNED_P (float_ptr, type)))) \ + *float_ptr = scm_to_double (val); \ + else \ + { \ + SYNC_REGISTER (); \ + scm_bytevector_ ## fn_stem ## _native_set_x (bv, idx, val); \ + } \ + NEXT; \ } VM_DEFINE_INSTRUCTION (200, bv_u8_set, "bv-u8-set", 0, 3, 0) From ecba00af6501e082b86c8f2f7730081c733509d7 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Mar 2011 20:20:14 +0100 Subject: [PATCH 127/183] with-continuation-barrier carps, calls exit(3) _after_ unwinding * libguile/continuations.c (scm_handler, c_handler) (scm_c_with_continuation_barrier, scm_with_continuation_barrier): Call scm_handle_by_message_noexit in the post-unwind handler, so that dynwinds * test-suite/tests/continuations.test ("continuations"): Add a test. --- libguile/continuations.c | 16 +++++++++++++--- test-suite/tests/continuations.test | 13 ++++++++++++- 2 files changed, 25 insertions(+), 4 deletions(-) diff --git a/libguile/continuations.c b/libguile/continuations.c index dc6850e05..28b6236c7 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -477,7 +477,13 @@ c_body (void *d) static SCM c_handler (void *d, SCM tag, SCM args) { - struct c_data *data = (struct c_data *)d; + struct c_data *data; + + /* Print a message. Note that if TAG is `quit', this will exit() the + process. */ + scm_handle_by_message_noexit (NULL, tag, args); + + data = (struct c_data *)d; data->result = NULL; return SCM_UNSPECIFIED; } @@ -490,7 +496,7 @@ scm_c_with_continuation_barrier (void *(*func) (void *), void *data) c_data.data = data; scm_i_with_continuation_barrier (c_body, &c_data, c_handler, &c_data, - scm_handle_by_message_noexit, NULL); + NULL, NULL); return c_data.result; } @@ -508,6 +514,10 @@ scm_body (void *d) static SCM scm_handler (void *d, SCM tag, SCM args) { + /* Print a message. Note that if TAG is `quit', this will exit() the + process. */ + scm_handle_by_message_noexit (NULL, tag, args); + return SCM_BOOL_F; } @@ -529,7 +539,7 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0, scm_data.proc = proc; return scm_i_with_continuation_barrier (scm_body, &scm_data, scm_handler, &scm_data, - scm_handle_by_message_noexit, NULL); + NULL, NULL); } #undef FUNC_NAME diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test index f6db40e58..a436b90d4 100644 --- a/test-suite/tests/continuations.test +++ b/test-suite/tests/continuations.test @@ -1,7 +1,7 @@ ;;;; -*- scheme -*- ;;;; continuations.test --- test suite for continutations ;;;; -;;;; Copyright (C) 2003, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006, 2009, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -80,6 +80,17 @@ (error "Catch me if you can!"))))))))) handled)) + (pass-if "exit unwinds dynwinds inside a continuation barrier" + (let ((s (with-error-to-string + (lambda () + (with-continuation-barrier + (lambda () + (dynamic-wind + (lambda () #f) + (lambda () (exit 1)) + (lambda () (throw 'abcde))))))))) + (and (string-contains s "abcde") #t))) + (with-debugging-evaluator (pass-if "make a stack from a continuation" From 5f0d2951a0a5179038bee55fe9af688f94738075 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Mar 2011 20:34:31 +0100 Subject: [PATCH 128/183] bdw-gc 6.8 compatibility (hopefully) * configure.ac (HAVE_GC_STACK_BASE): New check. * libguile/threads.c (GC_UNIMPLEMENTED, GC_SUCCESS): Define if needed. (GC_register_my_thread, GC_unregister_my_thread) (GC_call_with_stack_base): Define shims if needed. --- configure.ac | 7 +++++++ libguile/threads.c | 31 +++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) diff --git a/configure.ac b/configure.ac index ba6ff4900..6f24d8db4 100644 --- a/configure.ac +++ b/configure.ac @@ -1256,6 +1256,13 @@ AC_CHECK_TYPE([GC_fn_type], [], [#include ]) +# `GC_stack_base' is not available in GC 7.1 and earlier. +AC_CHECK_TYPE([struct GC_stack_base], + [AC_DEFINE([HAVE_GC_STACK_BASE], [1], + [Define this if the `GC_stack_base' type is available.])], + [], + [#include ]) + LIBS="$save_LIBS" diff --git a/libguile/threads.c b/libguile/threads.c index e2e17acc6..6f75dbe19 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -79,6 +79,37 @@ typedef void * (* GC_fn_type) (void *); #endif +#ifndef GC_SUCCESS +#define GC_SUCCESS 0 +#endif + +#ifndef GC_UNIMPLEMENTED +#define GC_UNIMPLEMENTED 3 +#endif + +/* Likewise struct GC_stack_base is missing before 7.1. */ +#ifndef HAVE_GC_STACK_BASE +struct GC_stack_base; + +static int +GC_register_my_thread (struct GC_stack_base *) +{ + return GC_UNIMPLEMENTED; +} + +static void +GC_unregister_my_thread () +{ +} + +static void * +GC_call_with_stack_base(void * (*fn) (struct GC_stack_base*, void*), void *arg) +{ + return fn (NULL, arg); +} +#endif + + /* Now define with_gc_active and with_gc_inactive. */ #if (defined(HAVE_GC_DO_BLOCKING) && defined (HAVE_DECL_GC_DO_BLOCKING) && defined (HAVE_GC_CALL_WITH_GC_ACTIVE)) From 2a6f90e52436afdbbcdcf99bfe8a5c24cefd9769 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 25 Mar 2011 10:47:10 +0100 Subject: [PATCH 129/183] Revert "with-continuation-barrier carps, calls exit(3) _after_ unwinding" This reverts commit ecba00af6501e082b86c8f2f7730081c733509d7. --- libguile/continuations.c | 16 +++------------- test-suite/tests/continuations.test | 13 +------------ 2 files changed, 4 insertions(+), 25 deletions(-) diff --git a/libguile/continuations.c b/libguile/continuations.c index 28b6236c7..dc6850e05 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -477,13 +477,7 @@ c_body (void *d) static SCM c_handler (void *d, SCM tag, SCM args) { - struct c_data *data; - - /* Print a message. Note that if TAG is `quit', this will exit() the - process. */ - scm_handle_by_message_noexit (NULL, tag, args); - - data = (struct c_data *)d; + struct c_data *data = (struct c_data *)d; data->result = NULL; return SCM_UNSPECIFIED; } @@ -496,7 +490,7 @@ scm_c_with_continuation_barrier (void *(*func) (void *), void *data) c_data.data = data; scm_i_with_continuation_barrier (c_body, &c_data, c_handler, &c_data, - NULL, NULL); + scm_handle_by_message_noexit, NULL); return c_data.result; } @@ -514,10 +508,6 @@ scm_body (void *d) static SCM scm_handler (void *d, SCM tag, SCM args) { - /* Print a message. Note that if TAG is `quit', this will exit() the - process. */ - scm_handle_by_message_noexit (NULL, tag, args); - return SCM_BOOL_F; } @@ -539,7 +529,7 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0, scm_data.proc = proc; return scm_i_with_continuation_barrier (scm_body, &scm_data, scm_handler, &scm_data, - NULL, NULL); + scm_handle_by_message_noexit, NULL); } #undef FUNC_NAME diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test index a436b90d4..f6db40e58 100644 --- a/test-suite/tests/continuations.test +++ b/test-suite/tests/continuations.test @@ -1,7 +1,7 @@ ;;;; -*- scheme -*- ;;;; continuations.test --- test suite for continutations ;;;; -;;;; Copyright (C) 2003, 2006, 2009, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006, 2009 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -80,17 +80,6 @@ (error "Catch me if you can!"))))))))) handled)) - (pass-if "exit unwinds dynwinds inside a continuation barrier" - (let ((s (with-error-to-string - (lambda () - (with-continuation-barrier - (lambda () - (dynamic-wind - (lambda () #f) - (lambda () (exit 1)) - (lambda () (throw 'abcde))))))))) - (and (string-contains s "abcde") #t))) - (with-debugging-evaluator (pass-if "make a stack from a continuation" From 12c1d8616d8dfedcad65f34e3968f9544b629ae1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 25 Mar 2011 13:01:51 +0100 Subject: [PATCH 130/183] threading / with_guile refactor to use more GC_stack_base * libguile/init.h: * libguile/init.c (scm_i_init_guile): Change arg to this internal function from SCM_STACKITEM* to void*. Actually it's a struct GC_stack_base*. * libguile/bdw-gc.h: Don't do pthread redirects, because we don't want to affect applications' pthread_* bindings. * libguile/pthread-threads.h (scm_i_pthread_create) (scm_i_pthread_detach, scm_i_pthread_exit, scm_i_pthread_cancel) (scm_i_pthread_sigmask): Do pthread redirects here, in this internal header. * libguile/threads.h: Remove declaration of internal scm_i_with_guile_and_parent. Remove declaration of undefined scm_threads_init_first_thread. Make declaration of internal scm_threads_prehistory actually internal, and take a void* (actually a struct GC_stack_base*). * libguile/threads.c (GC_get_stack_base): Implement a shim if this function is unavailable, and fold in the implementations of get_thread_stack_base. (GC_call_with_stack_base): Actually implement. (guilify_self_1): Take a GC_stack_base* as an arg. (scm_i_init_thread_for_guile): Likewise, and set up libgc for registration of other threads. (scm_init_guile): Use GC_get_stack_base instead of our own guesswork. (with_guile_and_parent, scm_i_with_guile_and_parent): Rework to trampoline through a GC_call_with_stack_base. (scm_threads_prehistory): Pass the "base" arg on to guilify_self_1. --- libguile/bdw-gc.h | 7 +- libguile/init.c | 8 +- libguile/init.h | 4 +- libguile/pthread-threads.h | 14 +- libguile/threads.c | 274 ++++++++++++++++++++----------------- libguile/threads.h | 8 +- 6 files changed, 163 insertions(+), 152 deletions(-) diff --git a/libguile/bdw-gc.h b/libguile/bdw-gc.h index 3adf99e66..61c11eb94 100644 --- a/libguile/bdw-gc.h +++ b/libguile/bdw-gc.h @@ -1,7 +1,7 @@ #ifndef SCM_BDW_GC_H #define SCM_BDW_GC_H -/* Copyright (C) 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2008, 2009, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -32,6 +32,11 @@ # define GC_THREADS 1 # define GC_REDIRECT_TO_LOCAL 1 +/* Don't #define pthread routines to their GC_pthread counterparts. + Instead we will be careful inside Guile to use the GC_pthread + routines. */ +# define GC_NO_THREAD_REDIRECTS 1 + #endif #include diff --git a/libguile/init.c b/libguile/init.c index d6a710504..8b3b8cd33 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -376,17 +376,11 @@ cleanup_for_exit () } void -scm_i_init_guile (SCM_STACKITEM *base) +scm_i_init_guile (void *base) { if (scm_initialized_p) return; - if (base == NULL) - { - fprintf (stderr, "cannot determine stack base!\n"); - abort (); - } - if (sizeof (mpz_t) > (3 * sizeof (scm_t_bits))) { fprintf (stderr, diff --git a/libguile/init.h b/libguile/init.h index 7cfae76d5..bc6cddf93 100644 --- a/libguile/init.h +++ b/libguile/init.h @@ -3,7 +3,7 @@ #ifndef SCM_INIT_H #define SCM_INIT_H -/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -38,7 +38,7 @@ SCM_API void scm_boot_guile (int argc, char **argv, char **argv), void *closure); -SCM_INTERNAL void scm_i_init_guile (SCM_STACKITEM *base); +SCM_INTERNAL void scm_i_init_guile (void *base); SCM_API void scm_load_startup_files (void); diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h index ca72f1674..c180af252 100644 --- a/libguile/pthread-threads.h +++ b/libguile/pthread-threads.h @@ -3,7 +3,7 @@ #ifndef SCM_PTHREADS_THREADS_H #define SCM_PTHREADS_THREADS_H -/* Copyright (C) 2002, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2005, 2006, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -29,24 +29,24 @@ #include #include -/* `libgc' intercepts pthread calls by defining wrapping macros. */ +/* `libgc' defines wrapper procedures for pthread calls. */ #include "libguile/bdw-gc.h" /* Threads */ #define scm_i_pthread_t pthread_t #define scm_i_pthread_self pthread_self -#define scm_i_pthread_create pthread_create -#define scm_i_pthread_detach pthread_detach -#define scm_i_pthread_exit pthread_exit -#define scm_i_pthread_cancel pthread_cancel +#define scm_i_pthread_create GC_pthread_create +#define scm_i_pthread_detach GC_pthread_detach +#define scm_i_pthread_exit GC_pthread_exit +#define scm_i_pthread_cancel GC_pthread_cancel #define scm_i_pthread_cleanup_push pthread_cleanup_push #define scm_i_pthread_cleanup_pop pthread_cleanup_pop #define scm_i_sched_yield sched_yield /* Signals */ -#define scm_i_pthread_sigmask pthread_sigmask +#define scm_i_pthread_sigmask GC_pthread_sigmask /* Mutexes */ diff --git a/libguile/threads.c b/libguile/threads.c index 6f75dbe19..2f5569fb5 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -89,7 +89,12 @@ typedef void * (* GC_fn_type) (void *); /* Likewise struct GC_stack_base is missing before 7.1. */ #ifndef HAVE_GC_STACK_BASE -struct GC_stack_base; +struct GC_stack_base { + void * mem_base; /* Base of memory stack. */ +#ifdef __ia64__ + void * reg_base; /* Base of separate register stack. */ +#endif +}; static int GC_register_my_thread (struct GC_stack_base *) @@ -102,13 +107,93 @@ GC_unregister_my_thread () { } +#if !SCM_USE_PTHREAD_THREADS +/* No threads; we can just use GC_stackbottom. */ +static void * +get_thread_stack_base () +{ + return GC_stackbottom; +} + +#elif defined HAVE_PTHREAD_ATTR_GETSTACK && defined HAVE_PTHREAD_GETATTR_NP \ + && defined PTHREAD_ATTR_GETSTACK_WORKS +/* This method for GNU/Linux and perhaps some other systems. + It's not for MacOS X or Solaris 10, since pthread_getattr_np is not + available on them. */ +static void * +get_thread_stack_base () +{ + pthread_attr_t attr; + void *start, *end; + size_t size; + + pthread_getattr_np (pthread_self (), &attr); + pthread_attr_getstack (&attr, &start, &size); + end = (char *)start + size; + +#if SCM_STACK_GROWS_UP + return start; +#else + return end; +#endif +} + +#elif defined HAVE_PTHREAD_GET_STACKADDR_NP +/* This method for MacOS X. + It'd be nice if there was some documentation on pthread_get_stackaddr_np, + but as of 2006 there's nothing obvious at apple.com. */ +static void * +get_thread_stack_base () +{ + return pthread_get_stackaddr_np (pthread_self ()); +} + +#else +#error Threads enabled with old BDW-GC, but missing get_thread_stack_base impl. Please upgrade to libgc >= 7.1. +#endif + +static int +GC_get_stack_base (struct GC_stack_base *) +{ + stack_base->mem_base = get_thread_stack_base (); +#ifdef __ia64__ + /* Calculate and store off the base of this thread's register + backing store (RBS). Unfortunately our implementation(s) of + scm_ia64_register_backing_store_base are only reliable for the + main thread. For other threads, therefore, find out the current + top of the RBS, and use that as a maximum. */ + stack_base->reg_base = scm_ia64_register_backing_store_base (); + { + ucontext_t ctx; + void *bsp; + getcontext (&ctx); + bsp = scm_ia64_ar_bsp (&ctx); + if (stack_base->reg_base > bsp) + stack_base->reg_base = bsp; + } +#endif + return GC_SUCCESS; +} + static void * GC_call_with_stack_base(void * (*fn) (struct GC_stack_base*, void*), void *arg) { - return fn (NULL, arg); -} + struct GC_stack_base stack_base; + + stack_base.mem_base = (void*)&stack_base; +#ifdef __ia64__ + /* FIXME: Untested. */ + { + ucontext_t ctx; + getcontext (&ctx); + stack_base.reg_base = scm_ia64_ar_bsp (&ctx); + } #endif + return fn (&stack_base, arg); +} +#endif /* HAVE_GC_STACK_BASE */ + /* Now define with_gc_active and with_gc_inactive. */ @@ -401,7 +486,7 @@ static SCM scm_i_default_dynamic_state; /* Perform first stage of thread initialisation, in non-guile mode. */ static void -guilify_self_1 (SCM_STACKITEM *base) +guilify_self_1 (struct GC_stack_base *base) { scm_i_thread *t = scm_gc_malloc (sizeof (scm_i_thread), "thread"); @@ -418,25 +503,12 @@ guilify_self_1 (SCM_STACKITEM *base) t->block_asyncs = 1; t->pending_asyncs = 1; t->critical_section_level = 0; - t->base = base; + t->base = base->mem_base; #ifdef __ia64__ - /* Calculate and store off the base of this thread's register - backing store (RBS). Unfortunately our implementation(s) of - scm_ia64_register_backing_store_base are only reliable for the - main thread. For other threads, therefore, find out the current - top of the RBS, and use that as a maximum. */ - t->register_backing_store_base = scm_ia64_register_backing_store_base (); - { - ucontext_t ctx; - void *bsp; - getcontext (&ctx); - bsp = scm_ia64_ar_bsp (&ctx); - if (t->register_backing_store_base > bsp) - t->register_backing_store_base = bsp; - } + t->register_backing_store_base = base->reg-base; #endif t->continuation_root = SCM_EOL; - t->continuation_base = base; + t->continuation_base = t->base; scm_i_pthread_cond_init (&t->sleep_cond, NULL); t->sleep_mutex = NULL; t->sleep_object = SCM_BOOL_F; @@ -668,7 +740,7 @@ init_thread_key (void) be sure. New threads are put into guile mode implicitly. */ static int -scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) +scm_i_init_thread_for_guile (struct GC_stack_base *base, SCM parent) { scm_i_pthread_once (&init_thread_key_once, init_thread_key); @@ -690,6 +762,10 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) initialization. */ scm_i_init_guile (base); + + /* Allow other threads to come in later. */ + GC_allow_register_threads (); + scm_i_pthread_mutex_unlock (&scm_i_init_mutex); } else @@ -698,6 +774,10 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) the first time. Only initialize this thread. */ scm_i_pthread_mutex_unlock (&scm_i_init_mutex); + + /* Register this thread with libgc. */ + GC_register_my_thread (base); + guilify_self_1 (base); guilify_self_2 (parent); } @@ -705,97 +785,19 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) } } -#if SCM_USE_PTHREAD_THREADS - -#if defined HAVE_PTHREAD_ATTR_GETSTACK && defined HAVE_PTHREAD_GETATTR_NP -/* This method for GNU/Linux and perhaps some other systems. - It's not for MacOS X or Solaris 10, since pthread_getattr_np is not - available on them. */ -#define HAVE_GET_THREAD_STACK_BASE - -static SCM_STACKITEM * -get_thread_stack_base () -{ - pthread_attr_t attr; - void *start, *end; - size_t size; - - pthread_getattr_np (pthread_self (), &attr); - pthread_attr_getstack (&attr, &start, &size); - end = (char *)start + size; - - /* XXX - pthread_getattr_np from LinuxThreads does not seem to work - for the main thread, but we can use scm_get_stack_base in that - case. - */ - -#ifndef PTHREAD_ATTR_GETSTACK_WORKS - if ((void *)&attr < start || (void *)&attr >= end) - return (SCM_STACKITEM *) GC_stackbottom; - else -#endif - { -#if SCM_STACK_GROWS_UP - return start; -#else - return end; -#endif - } -} - -#elif defined HAVE_PTHREAD_GET_STACKADDR_NP -/* This method for MacOS X. - It'd be nice if there was some documentation on pthread_get_stackaddr_np, - but as of 2006 there's nothing obvious at apple.com. */ -#define HAVE_GET_THREAD_STACK_BASE -static SCM_STACKITEM * -get_thread_stack_base () -{ - return pthread_get_stackaddr_np (pthread_self ()); -} - -#elif defined (__MINGW32__) -/* This method for mingw. In mingw the basic scm_get_stack_base can be used - in any thread. We don't like hard-coding the name of a system, but there - doesn't seem to be a cleaner way of knowing scm_get_stack_base can - work. */ -#define HAVE_GET_THREAD_STACK_BASE -static SCM_STACKITEM * -get_thread_stack_base () -{ - return (SCM_STACKITEM *) GC_stackbottom; -} - -#endif /* pthread methods of get_thread_stack_base */ - -#else /* !SCM_USE_PTHREAD_THREADS */ - -#define HAVE_GET_THREAD_STACK_BASE - -static SCM_STACKITEM * -get_thread_stack_base () -{ - return (SCM_STACKITEM *) GC_stackbottom; -} - -#endif /* !SCM_USE_PTHREAD_THREADS */ - -#ifdef HAVE_GET_THREAD_STACK_BASE - void scm_init_guile () { - scm_i_init_thread_for_guile (get_thread_stack_base (), - scm_i_default_dynamic_state); -} - -#endif - -void * -scm_with_guile (void *(*func)(void *), void *data) -{ - return scm_i_with_guile_and_parent (func, data, - scm_i_default_dynamic_state); + struct GC_stack_base stack_base; + + if (GC_get_stack_base (&stack_base) == GC_SUCCESS) + scm_i_init_thread_for_guile (&stack_base, + scm_i_default_dynamic_state); + else + { + fprintf (stderr, "Failed to get stack base for current thread.\n"); + exit (1); + } } SCM_UNUSED static void @@ -804,36 +806,37 @@ scm_leave_guile_cleanup (void *x) on_thread_exit (SCM_I_CURRENT_THREAD); } -struct with_guile_trampoline_args +struct with_guile_args { GC_fn_type func; void *data; + SCM parent; }; static void * with_guile_trampoline (void *data) { - struct with_guile_trampoline_args *args = data; + struct with_guile_args *args = data; return scm_c_with_continuation_barrier (args->func, args->data); } -void * -scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) +static void * +with_guile_and_parent (struct GC_stack_base *base, void *data) { void *res; int new_thread; scm_i_thread *t; - SCM_STACKITEM base_item; + struct with_guile_args *args = data; - new_thread = scm_i_init_thread_for_guile (&base_item, parent); + new_thread = scm_i_init_thread_for_guile (base, args->parent); t = SCM_I_CURRENT_THREAD; if (new_thread) { /* We are in Guile mode. */ assert (t->guile_mode); - res = scm_c_with_continuation_barrier (func, data); + res = scm_c_with_continuation_barrier (args->func, args->data); /* Leave Guile mode. */ t->guile_mode = 0; @@ -841,14 +844,10 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) else if (t->guile_mode) { /* Already in Guile mode. */ - res = scm_c_with_continuation_barrier (func, data); + res = scm_c_with_continuation_barrier (args->func, args->data); } else { - struct with_guile_trampoline_args args; - args.func = func; - args.data = data; - /* We are not in Guile mode, either because we are not within a scm_with_guile, or because we are within a scm_without_guile. @@ -857,20 +856,39 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) when this thread was first guilified. Thus, `base' must be updated. */ #if SCM_STACK_GROWS_UP - if (SCM_STACK_PTR (&base_item) < t->base) - t->base = SCM_STACK_PTR (&base_item); + if (SCM_STACK_PTR (base->mem_base) < t->base) + t->base = SCM_STACK_PTR (base->mem_base); #else - if (SCM_STACK_PTR (&base_item) > t->base) - t->base = SCM_STACK_PTR (&base_item); + if (SCM_STACK_PTR (base->mem_base) > t->base) + t->base = SCM_STACK_PTR (base->mem_base); #endif t->guile_mode = 1; - res = with_gc_active (with_guile_trampoline, &args); + res = with_gc_active (with_guile_trampoline, args); t->guile_mode = 0; } return res; } +static void * +scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) +{ + struct with_guile_args args; + + args.func = func; + args.data = data; + args.parent = parent; + + return GC_call_with_stack_base (with_guile_and_parent, &args); +} + +void * +scm_with_guile (void *(*func)(void *), void *data) +{ + return scm_i_with_guile_and_parent (func, data, + scm_i_default_dynamic_state); +} + void * scm_without_guile (void *(*func)(void *), void *data) { @@ -2003,7 +2021,7 @@ pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1]; #endif void -scm_threads_prehistory (SCM_STACKITEM *base) +scm_threads_prehistory (void *base) { #if SCM_USE_PTHREAD_THREADS pthread_mutexattr_init (scm_i_pthread_mutexattr_recursive); @@ -2016,7 +2034,7 @@ scm_threads_prehistory (SCM_STACKITEM *base) scm_i_pthread_mutex_init (&scm_i_misc_mutex, NULL); scm_i_pthread_cond_init (&wake_up_cond, NULL); - guilify_self_1 (base); + guilify_self_1 ((struct GC_stack_base *) base); } scm_t_bits scm_tc16_thread; diff --git a/libguile/threads.h b/libguile/threads.h index 475af328c..9e44684e1 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -136,13 +136,7 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data, SCM_API void *scm_without_guile (void *(*func)(void *), void *data); SCM_API void *scm_with_guile (void *(*func)(void *), void *data); -SCM_INTERNAL void *scm_i_with_guile_and_parent (void *(*func)(void *), - void *data, SCM parent); - - -void scm_threads_prehistory (SCM_STACKITEM *); -void scm_threads_init_first_thread (void); - +SCM_INTERNAL void scm_threads_prehistory (void *); SCM_INTERNAL void scm_init_threads (void); SCM_INTERNAL void scm_init_thread_procs (void); SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); From 7f22442b2af85ea9db89c84fbd3acb6a96ee13fd Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 25 Mar 2011 15:35:20 +0100 Subject: [PATCH 131/183] avoid running GC when SCM_I_CURRENT_THREAD is unset * libguile/threads.c (guilify_self_1): Prevent finalizers from running before SCM_I_CURRENT_THREAD is set. (do_thread_exit_trampoline): Leave the thread in the registered state. (on_thread_exit): Always unregister the thread here. --- libguile/threads.c | 113 ++++++++++++++++++++++++--------------------- 1 file changed, 61 insertions(+), 52 deletions(-) diff --git a/libguile/threads.c b/libguile/threads.c index 2f5569fb5..ad5bbe19f 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -488,57 +488,73 @@ static SCM scm_i_default_dynamic_state; static void guilify_self_1 (struct GC_stack_base *base) { - scm_i_thread *t = scm_gc_malloc (sizeof (scm_i_thread), "thread"); + scm_i_thread t; - t->pthread = scm_i_pthread_self (); - t->handle = SCM_BOOL_F; - t->result = SCM_BOOL_F; - t->cleanup_handler = SCM_BOOL_F; - t->mutexes = SCM_EOL; - t->held_mutex = NULL; - t->join_queue = SCM_EOL; - t->dynamic_state = SCM_BOOL_F; - t->dynwinds = SCM_EOL; - t->active_asyncs = SCM_EOL; - t->block_asyncs = 1; - t->pending_asyncs = 1; - t->critical_section_level = 0; - t->base = base->mem_base; + /* We must arrange for SCM_I_CURRENT_THREAD to point to a valid value + before allocating anything in this thread, because allocation could + cause GC to run, and GC could cause finalizers, which could invoke + Scheme functions, which need the current thread to be set. */ + + t.pthread = scm_i_pthread_self (); + t.handle = SCM_BOOL_F; + t.result = SCM_BOOL_F; + t.cleanup_handler = SCM_BOOL_F; + t.mutexes = SCM_EOL; + t.held_mutex = NULL; + t.join_queue = SCM_EOL; + t.dynamic_state = SCM_BOOL_F; + t.dynwinds = SCM_EOL; + t.active_asyncs = SCM_EOL; + t.block_asyncs = 1; + t.pending_asyncs = 1; + t.critical_section_level = 0; + t.base = base->mem_base; #ifdef __ia64__ - t->register_backing_store_base = base->reg-base; + t.register_backing_store_base = base->reg-base; #endif - t->continuation_root = SCM_EOL; - t->continuation_base = t->base; - scm_i_pthread_cond_init (&t->sleep_cond, NULL); - t->sleep_mutex = NULL; - t->sleep_object = SCM_BOOL_F; - t->sleep_fd = -1; + t.continuation_root = SCM_EOL; + t.continuation_base = t.base; + scm_i_pthread_cond_init (&t.sleep_cond, NULL); + t.sleep_mutex = NULL; + t.sleep_object = SCM_BOOL_F; + t.sleep_fd = -1; - if (pipe (t->sleep_pipe) != 0) + if (pipe (t.sleep_pipe) != 0) /* FIXME: Error conditions during the initialization phase are handled gracelessly since public functions such as `scm_init_guile ()' currently have type `void'. */ abort (); - scm_i_pthread_mutex_init (&t->admin_mutex, NULL); - t->current_mark_stack_ptr = NULL; - t->current_mark_stack_limit = NULL; - t->canceled = 0; - t->exited = 0; - t->guile_mode = 0; + scm_i_pthread_mutex_init (&t.admin_mutex, NULL); + t.current_mark_stack_ptr = NULL; + t.current_mark_stack_limit = NULL; + t.canceled = 0; + t.exited = 0; + t.guile_mode = 0; - scm_i_pthread_setspecific (scm_i_thread_key, t); + /* The switcheroo. */ + { + scm_i_thread *t_ptr = &t; + + GC_disable (); + t_ptr = GC_malloc (sizeof (scm_i_thread)); + memcpy (t_ptr, &t, sizeof t); + + scm_i_pthread_setspecific (scm_i_thread_key, t_ptr); #ifdef SCM_HAVE_THREAD_STORAGE_CLASS - /* Cache the current thread in TLS for faster lookup. */ - scm_i_current_thread = t; + /* Cache the current thread in TLS for faster lookup. */ + scm_i_current_thread = t_ptr; #endif - scm_i_pthread_mutex_lock (&thread_admin_mutex); - t->next_thread = all_threads; - all_threads = t; - thread_count++; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + scm_i_pthread_mutex_lock (&thread_admin_mutex); + t_ptr->next_thread = all_threads; + all_threads = t_ptr; + thread_count++; + scm_i_pthread_mutex_unlock (&thread_admin_mutex); + + GC_enable (); + } } /* Perform second stage of thread initialisation, in guile mode. @@ -644,17 +660,10 @@ do_thread_exit (void *v) static void * do_thread_exit_trampoline (struct GC_stack_base *sb, void *v) { - void *ret; - int registered; + /* Won't hurt if we are already registered. */ + GC_register_my_thread (sb); - registered = GC_register_my_thread (sb); - - ret = scm_with_guile (do_thread_exit, v); - - if (registered == GC_SUCCESS) - GC_unregister_my_thread (); - - return ret; + return scm_with_guile (do_thread_exit, v); } static void @@ -680,11 +689,9 @@ on_thread_exit (void *v) shutting it down. */ scm_i_ensure_signal_delivery_thread (); - /* Unblocking the joining threads needs to happen in guile mode - since the queue is a SCM data structure. Trampoline through - GC_call_with_stack_base so that the GC works even if it already - cleaned up for this thread. */ - GC_call_with_stack_base (do_thread_exit_trampoline, v); + /* Scheme-level thread finalizers and other cleanup needs to happen in + guile mode. */ + GC_call_with_stack_base (do_thread_exit_trampoline, t); /* Removing ourself from the list of all threads needs to happen in non-guile mode since all SCM values on our stack become @@ -712,6 +719,8 @@ on_thread_exit (void *v) scm_i_pthread_mutex_unlock (&thread_admin_mutex); scm_i_pthread_setspecific (scm_i_thread_key, NULL); + + GC_unregister_my_thread (); } static scm_i_pthread_once_t init_thread_key_once = SCM_I_PTHREAD_ONCE_INIT; From 29ee01c009c46969a6b5570daf0a021a541c2d17 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 20 Mar 2011 22:27:38 +0000 Subject: [PATCH 132/183] Remove unused definition of preinstguiletool * am/pre-inst-guile (preinstguiletool): Removed. --- am/pre-inst-guile | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/am/pre-inst-guile b/am/pre-inst-guile index 7993d1531..b7b0d3469 100644 --- a/am/pre-inst-guile +++ b/am/pre-inst-guile @@ -1,6 +1,6 @@ -## am/pre-inst-guile --- define preinstguile and preinstguiletool vars +## am/pre-inst-guile --- define preinstguile -## Copyright (C) 2002, 2006 Free Software Foundation +## Copyright (C) 2002, 2006, 2011 Free Software Foundation ## ## This file is part of GUILE. ## @@ -21,7 +21,7 @@ ## Commentary: -## This fragment defines two variables: preinstguile, preinstguiletool. +## This fragment defines the preinstguile variable ## It can be included in any Makefile.am by adding the line: ## include $(top_srcdir)/am/pre-inst-guile ## See devel/build/pre-inst-guile.text (CVS only) for more info. @@ -29,6 +29,5 @@ ## Code: preinstguile = $(top_builddir_absolute)/meta/guile -preinstguiletool = GUILE="$(preinstguile)" $(top_srcdir)/scripts ## am/pre-inst-guile ends here From 08e6b25ca2184bed67d38be4db26561ee713b290 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 20 Mar 2011 22:48:33 +0000 Subject: [PATCH 133/183] GUILE_FOR_BUILD is only needed by meta/guile.in, not by Makefiles * configure.ac: Use AM_SUBST_NOTMAKE for GUILE_FOR_BUILD instead of AC_SUBST. --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 6f24d8db4..ccc1e3189 100644 --- a/configure.ac +++ b/configure.ac @@ -1503,7 +1503,7 @@ if test "$cross_compiling" = "yes"; then AC_MSG_RESULT($GUILE_FOR_BUILD) fi AC_ARG_VAR(GUILE_FOR_BUILD,[guile for build system]) -AC_SUBST(GUILE_FOR_BUILD) +AM_SUBST_NOTMAKE(GUILE_FOR_BUILD) ## If we're using GCC, ask for aggressive warnings. GCC_CFLAGS="" From aab99f7b8b74204993c7b9f8bc4ac3703551028b Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 20 Mar 2011 23:02:33 +0000 Subject: [PATCH 134/183] Make explicit that GUILE_FOR_BUILD is only used when cross-compiling * configure.ac (GUILE_FOR_BUILD): Change normal build value to 'this-value-will-never-be-used'. --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index ccc1e3189..a254634b5 100644 --- a/configure.ac +++ b/configure.ac @@ -1494,7 +1494,7 @@ if test "$cross_compiling" = "yes"; then AC_MSG_CHECKING(guile for build) GUILE_FOR_BUILD="${GUILE_FOR_BUILD-guile}" else - GUILE_FOR_BUILD='$(preinstguile)' + GUILE_FOR_BUILD='this-value-will-never-be-used' fi ## AC_MSG_CHECKING("if we are cross compiling") From 6b8bc6f8b507928f9b0bd71000f5132c984db798 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 20 Mar 2011 23:50:22 +0000 Subject: [PATCH 135/183] Inline the effect of am/pre-inst-guile It's just one variable definition, and in my opinion it confuses, rather than helps, the overall build picture to have two names (preinstguile and meta/guile) for the same thing. * am/Makefile.am (am_frags): Remove pre-inst-guile. * am/pre-inst-guile: Deleted. * doc/ref/Makefile.am: Don't include am/pre-inst-guile. ($(snarf_doc).am, $(snarf_doc).texi): Expand $(preinstguile). * module/Makefile.am (ice-9/psyntax-pp.scm.gen): Don't include am/pre-inst-guile. (ice-9/psyntax-pp.scm.gen): Expand $(preinstguile). --- am/Makefile.am | 2 +- am/pre-inst-guile | 33 --------------------------------- doc/ref/Makefile.am | 7 +++---- module/Makefile.am | 3 +-- 4 files changed, 5 insertions(+), 40 deletions(-) delete mode 100644 am/pre-inst-guile diff --git a/am/Makefile.am b/am/Makefile.am index d1b7eccc7..e2044d6aa 100644 --- a/am/Makefile.am +++ b/am/Makefile.am @@ -21,7 +21,7 @@ AUTOMAKE_OPTIONS = gnu -am_frags = pre-inst-guile maintainer-dirs guilec +am_frags = maintainer-dirs guilec EXTRA_DIST = $(am_frags) ChangeLog-2008 diff --git a/am/pre-inst-guile b/am/pre-inst-guile deleted file mode 100644 index b7b0d3469..000000000 --- a/am/pre-inst-guile +++ /dev/null @@ -1,33 +0,0 @@ -## am/pre-inst-guile --- define preinstguile - -## Copyright (C) 2002, 2006, 2011 Free Software Foundation -## -## This file is part of GUILE. -## -## GUILE is free software; you can redistribute it and/or modify -## it under the terms of the GNU Lesser General Public License as -## published by the Free Software Foundation; either version 3, or -## (at your option) any later version. -## -## GUILE is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU Lesser General Public License for more details. -## -## You should have received a copy of the GNU Lesser General Public -## License along with GUILE; see the file COPYING.LESSER. If not, write -## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth -## Floor, Boston, MA 02110-1301 USA - -## Commentary: - -## This fragment defines the preinstguile variable -## It can be included in any Makefile.am by adding the line: -## include $(top_srcdir)/am/pre-inst-guile -## See devel/build/pre-inst-guile.text (CVS only) for more info. - -## Code: - -preinstguile = $(top_builddir_absolute)/meta/guile - -## am/pre-inst-guile ends here diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index c154f428d..0359380c2 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -111,8 +111,6 @@ noinst_DATA = $(PICTURES) EXTRA_DIST = ChangeLog-2008 $(PICTURES) -include $(top_srcdir)/am/pre-inst-guile - # Automated snarfing autoconf.texi: autoconf-macros.texi @@ -129,7 +127,8 @@ snarf_doc = standard-library $(snarf_doc).am: $(snarf_doc).scm GUILE_AUTO_COMPILE=0 ; \ variable="`echo $(snarf_doc) | tr - _`_scm_files" ; \ - "$(preinstguile)" -l "$(srcdir)/$(snarf_doc).scm" -c " \ + "$(top_builddir_absolute)/meta/guile" -l "$(srcdir)/$(snarf_doc).scm" \ + -c " \ (format #t \"# Automatically generated, do not edit.~%\") \ (format #t \"$$variable = \") \ (for-each (lambda (m) \ @@ -143,7 +142,7 @@ include standard-library.am $(snarf_doc).texi: $(standard_library_scm_files) GUILE_AUTO_COMPILE=0 \ - "$(preinstguile)" "$(srcdir)/make-texinfo.scm" \ + "$(top_builddir_absolute)/meta/guile" "$(srcdir)/make-texinfo.scm" \ "$(abs_srcdir)/$(snarf_doc).scm" > "$@.tmp" mv "$@.tmp" "$@" diff --git a/module/Makefile.am b/module/Makefile.am index b39b82719..2685a3a63 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -73,9 +73,8 @@ ETAGS_ARGS += \ ice-9/compile-psyntax.scm \ ice-9/ChangeLog-2008 -include $(top_srcdir)/am/pre-inst-guile ice-9/psyntax-pp.scm.gen: - $(preinstguile) --no-auto-compile -s $(srcdir)/ice-9/compile-psyntax.scm \ + $(top_builddir_absolute)/meta/guile --no-auto-compile -s $(srcdir)/ice-9/compile-psyntax.scm \ $(srcdir)/ice-9/psyntax.scm $(srcdir)/ice-9/psyntax-pp.scm .PHONY: ice-9/psyntax-pp.scm.gen From c6e05396dc73c3bcfa71b92b4689e8cb6d4588eb Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 21 Mar 2011 09:05:59 +0000 Subject: [PATCH 136/183] Remove statements about scripts/* that are no longer true * doc/ref/tools.texi (Executable Modules): Say "guile-tools modules" instead of "executable modules". Remove obsolete statements about not ending in .scm, being executable, and beginning with shell script invocation sequence. * module/scripts/README: Ditto. --- doc/ref/tools.texi | 33 +++++++-------------------------- module/scripts/README | 23 +++++------------------ 2 files changed, 12 insertions(+), 44 deletions(-) diff --git a/doc/ref/tools.texi b/doc/ref/tools.texi index 2f4f59ac9..7a98884d8 100644 --- a/doc/ref/tools.texi +++ b/doc/ref/tools.texi @@ -303,14 +303,11 @@ is rather byzantine, so for now @emph{NO} doc snarfing programs are installed. @cindex executable modules @cindex scripts -When Guile is installed, in addition to the @code{(ice-9 FOO)} modules, -a set of @dfn{executable modules} @code{(scripts BAR)} is also installed. -Each is a regular Scheme module that has some additional packaging so -that it can be called as a program in its own right, from the shell. For this -reason, we sometimes use the term @dfn{script} in this context to mean the -same thing. - -@c wow look at this hole^! variable-width font users eat your heart out. +When Guile is installed, in addition to the @code{(ice-9 FOO)} modules, a set +of @dfn{guile-tools modules} @code{(scripts BAR)} is also installed. Each is +a regular Scheme module that has some additional packaging so that it can be +used by guile-tools, from the shell. For this reason, we sometimes use the +term @dfn{script} in this context to mean the same thing. As a convenience, the @code{guile-tools} wrapper program is installed along w/ @code{guile}; it knows where a particular module is installed and calls it @@ -346,16 +343,10 @@ executable module. Feel free to skip to the next chapter. See template file @code{PROGRAM} for a quick start. -Programs must follow the @dfn{executable module} convention, documented here: +Programs must follow the @dfn{guile-tools} convention, documented here: @itemize -@item -The file name must not end in ".scm". - -@item -The file must be executable (chmod +x). - @item The module name must be "(scripts PROGRAM)". A procedure named PROGRAM w/ signature "(PROGRAM . args)" must be exported. Basically, use some variant @@ -377,20 +368,10 @@ There must be the alias: However, `main' must NOT be exported. -@item -The beginning of the file must use the following invocation sequence: - -@example -#!/bin/sh -main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')' -exec $@{GUILE-guile@} -l $0 -c "(apply $main (cdr (command-line)))" "$@@" -!# -@end example - @end itemize Following these conventions allows the program file to be used as module -@code{(scripts PROGRAM)} in addition to as a standalone executable. Please +@code{(scripts PROGRAM)} in addition to being invoked by guile-tools. Please also include a helpful Commentary section w/ some usage info. @c tools.texi ends here diff --git a/module/scripts/README b/module/scripts/README index 56dd286fb..cb397f5d2 100644 --- a/module/scripts/README +++ b/module/scripts/README @@ -4,9 +4,9 @@ Overview and Usage This directory contains Scheme programs, some useful in maintaining Guile. On "make install", these programs are copied to PKGDATADIR/VERSION/scripts. -You can invoke a program from the shell, or alternatively, load its file -as a Guile Scheme module, and use its exported procedure(s) from Scheme code. -Typically for any PROGRAM: +You can use guile-tools to invoke a program from the shell, or alternatively, +load its file as a Guile Scheme module, and use its exported procedure(s) +from Scheme code. Typically for any PROGRAM: (use-modules (scripts PROGRAM)) (PROGRAM ARG1 ARG2 ...) @@ -22,8 +22,6 @@ To see PROGRAM's commentary, which may or may not be helpful: (help (scripts PROGRAM)) -To see all commentaries and module dependencies, try: "make overview". - If you want to try the programs before installing Guile, you will probably need to set environment variable GUILE_LOAD_PATH to be the parent directory. This can be done in Bourne-compatible shells like so: @@ -40,11 +38,7 @@ How to Contribute See template file PROGRAM for a quick start. -Programs must follow the "executable module" convention, documented here: - -- The file name must not end in ".scm". - -- The file must be executable (chmod +x). +Programs must follow the "guile-tools" convention, documented here: - The module name must be "(scripts PROGRAM)". A procedure named PROGRAM w/ signature "(PROGRAM . args)" must be exported. Basically, use some variant @@ -61,15 +55,8 @@ Programs must follow the "executable module" convention, documented here: However, `main' must NOT be exported. -- The beginning of the file must use the following invocation sequence: - - #!/bin/sh - main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')' - exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" - !# - Following these conventions allows the program file to be used as module -(scripts PROGRAM) in addition to as a standalone executable. Please also +(scripts PROGRAM) in addition to being invoked by guile-tools. Please also include a helpful Commentary section w/ some usage info. From 362126aa96cbe2429d2a6202d0be63de6f93505b Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 26 Mar 2011 12:53:10 +0100 Subject: [PATCH 137/183] fix (texinfo reflection) to handle nested structures like syntax patterns * module/texinfo/reflection.scm (process-args): Convert any arg to a string. "Fixes" documentation of syntax-rules patterns. --- module/texinfo/reflection.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/module/texinfo/reflection.scm b/module/texinfo/reflection.scm index 52b1ee958..a69436f89 100644 --- a/module/texinfo/reflection.scm +++ b/module/texinfo/reflection.scm @@ -1,6 +1,6 @@ ;;;; (texinfo reflection) -- documenting Scheme as stexinfo ;;;; -;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 2003,2004,2009 Andy Wingo ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -86,7 +86,7 @@ (cons* (car in) infix out))))))) (define (process-args args) - (map (lambda (x) (if (symbol? x) (symbol->string x) x)) + (map (lambda (x) (if (string? x) x (object->string x))) (list*-join (or args '()) " " " . "))) From 38c50a99b695694b684662663294eaeba2bcba30 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 26 Mar 2011 13:33:21 +0100 Subject: [PATCH 138/183] fix stexi->html double translation * module/texinfo/html.scm (entry): Fix to avoid double translation: arg-req already pulls an stexi->shtml on its arg. --- module/texinfo/html.scm | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/module/texinfo/html.scm b/module/texinfo/html.scm index 81dd1f123..709744dc3 100644 --- a/module/texinfo/html.scm +++ b/module/texinfo/html.scm @@ -1,6 +1,6 @@ ;;;; (texinfo html) -- translating stexinfo into shtml ;;;; -;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 2003,2004,2009 Andy Wingo ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -148,14 +148,12 @@ name, @code{#}, and the node name." (apply append body))))) (define (entry tag args . body) - (let lp ((headings (list (arg-req 'heading args))) (body body)) + (let lp ((out `((dt ,@(arg-req 'heading args)))) + (body body)) (if (and (pair? body) (pair? (car body)) (eq? (caar body) 'itemx)) - (lp (cons (cdar body) headings) + (lp (append out `(dt ,@(map stexi->shtml (cdar body)))) (cdr body)) - `(,@(map (lambda (heading) - `(dt ,@(map stexi->shtml heading))) - headings) - (dd ,@(map stexi->shtml body)))))) + (append out `((dd ,@(map stexi->shtml body))))))) (define tag-replacements '((titlepage div (@ (class "titlepage"))) From 96c71c589a866e41b3a95ccc90318c6a28e42004 Mon Sep 17 00:00:00 2001 From: Bruno Haible Date: Sat, 26 Mar 2011 23:33:00 +0100 Subject: [PATCH 139/183] Update comment about uc_locale_language. * libguile/i18n.c (locale_language): Update comment. --- libguile/i18n.c | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/libguile/i18n.c b/libguile/i18n.c index 51bbc2f04..fc651fd7e 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -766,16 +766,10 @@ compare_u32_strings (SCM s1, SCM s2, SCM locale, const char *func_name) static const char * locale_language () { - /* FIXME: If the locale has been set with 'uselocale', - libunistring's uc_locale_language will return the incorrect - language: it will return the language appropriate for the global - (non-thread-specific) locale. - - There appears to be no portable way to extract the language from - the thread-specific locale_t. There is no LANGUAGE capability in - nl_langinfo or nl_langinfo_l. - - Thus, uc_locale_language needs to be fixed upstream. */ + /* Note: If the locale has been set with 'uselocale', uc_locale_language + from libunistring versions 0.9.1 and older will return the incorrect + (non-thread-specific) locale. This is fixed in versions 0.9.2 and + newer. */ return uc_locale_language (); } From 8e9af8541253577c15c94455ef31c762071aae64 Mon Sep 17 00:00:00 2001 From: Noah Lavine Date: Fri, 11 Mar 2011 11:45:33 -0500 Subject: [PATCH 140/183] Document SRFI-23 * doc/ref/srfi-modules.texi: mention that we support SRFI 23 * module/ice-9/boot-9.scm (%cond-expand-features): add srfi-23 --- doc/ref/srfi-modules.texi | 6 ++++++ module/ice-9/boot-9.scm | 1 + 2 files changed, 7 insertions(+) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index eab87794d..a5b9740f3 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -35,6 +35,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-17:: Generalized set! * SRFI-18:: Multithreading support * SRFI-19:: Time/Date library. +* SRFI-23:: Error reporting * SRFI-26:: Specializing parameters * SRFI-27:: Sources of Random Bits * SRFI-30:: Nested multi-line block comments @@ -3135,6 +3136,11 @@ Conversion is locale-dependent on systems that support it locale. @end defun +@node SRFI-23 +@subsection SRFI-23 - Error Reporting +@cindex SRFI-23 + +The SRFI-23 @code{error} procedure is always available. @node SRFI-26 @subsection SRFI-26 - specializing parameters diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index a0b207cff..33aa33382 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -3404,6 +3404,7 @@ module '(ice-9 q) '(make-q q-length))}." srfi-4 ;; homogenous numeric vectors srfi-6 ;; open-input-string etc, in the guile core srfi-13 ;; string library + srfi-23 ;; `error` procedure srfi-14 ;; character sets srfi-55 ;; require-extension srfi-61 ;; general cond clause From 62f528e929368ddce77f550168c229177793d854 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Mar 2011 14:44:20 +0200 Subject: [PATCH 141/183] tree-il->scheme fix * module/language/tree-il.scm (tree-il->scheme): Fix to Scheme serialization. --- module/language/tree-il.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 5fd4c125a..221cf264d 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -471,8 +471,9 @@ `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp))) (( tag body handler) - `((@ (ice-9 control) prompt) - ,(tree-il->scheme tag) (lambda () ,(tree-il->scheme body)) + `(call-with-prompt + ,(tree-il->scheme tag) + (lambda () ,(tree-il->scheme body)) ,(tree-il->scheme handler))) From 9dadfa47b07548ff5cf3604067910c8aece93c42 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 27 Mar 2011 15:00:18 +0200 Subject: [PATCH 142/183] fix prompt in fix in single-value context compilation * module/language/tree-il/compile-glil.scm (flatten): When compiling a in push context with an RA, after the body returns normally, jump to that RA instead of to our POST label (which in that case does not need to be emitted). Fixes a tail in a push . * test-suite/tests/control.test ("prompt in different contexts"): Add more test cases. --- module/language/tree-il/compile-glil.scm | 8 +- test-suite/tests/control.test | 95 ++++++++++++++++++++++++ 2 files changed, 99 insertions(+), 4 deletions(-) diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index 23648cdde..f193e9dcd 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -1,6 +1,6 @@ ;;; TREE-IL -> GLIL compiler -;; Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc. +;; Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -1095,7 +1095,7 @@ ;; post (comp-push body) (emit-code #f (make-glil-call 'unwind 0)) - (emit-branch #f 'br POST)) + (emit-branch #f 'br (or RA POST))) ((vals) (let ((MV (make-label))) @@ -1138,8 +1138,8 @@ (comp-tail body) (emit-code #f (make-glil-unbind)))) - (if (or (eq? context 'push) - (and (eq? context 'drop) (not RA))) + (if (and (not RA) + (or (eq? context 'push) (eq? context 'drop))) (emit-label POST)))) (( src tag args tail) diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test index ce2e1bf0a..6f1804a3f 100644 --- a/test-suite/tests/control.test +++ b/test-suite/tests/control.test @@ -178,6 +178,101 @@ (eq? (k 'xyzzy) 'xyzzy)))) +;; Here we test different cases for the `prompt'. +(with-test-prefix/c&e "prompt in different contexts" + (pass-if "push, normal exit" + (car (call-with-prompt + 'foo + (lambda () '(#t)) + (lambda (k) '(#f))))) + + (pass-if "push, nonlocal exit" + (car (call-with-prompt + 'foo + (lambda () (abort-to-prompt 'foo) '(#f)) + (lambda (k) '(#t))))) + + (pass-if "push with RA, normal exit" + (car (letrec ((test (lambda () + (call-with-prompt + 'foo + (lambda () '(#t)) + (lambda (k) '(#f)))))) + (test)))) + + (pass-if "push with RA, nonlocal exit" + (car (letrec ((test (lambda () + (call-with-prompt + 'foo + (lambda () (abort-to-prompt 'foo) '(#f)) + (lambda (k) '(#t)))))) + (test)))) + + (pass-if "tail, normal exit" + (call-with-prompt + 'foo + (lambda () #t) + (lambda (k) #f))) + + (pass-if "tail, nonlocal exit" + (call-with-prompt + 'foo + (lambda () (abort-to-prompt 'foo) #f) + (lambda (k) #t))) + + (pass-if "tail with RA, normal exit" + (letrec ((test (lambda () + (call-with-prompt + 'foo + (lambda () #t) + (lambda (k) #f))))) + (test))) + + (pass-if "tail with RA, nonlocal exit" + (letrec ((test (lambda () + (call-with-prompt + 'foo + (lambda () (abort-to-prompt 'foo) #f) + (lambda (k) #t))))) + (test))) + + (pass-if "drop, normal exit" + (begin + (call-with-prompt + 'foo + (lambda () #f) + (lambda (k) #f)) + #t)) + + (pass-if "drop, nonlocal exit" + (begin + (call-with-prompt + 'foo + (lambda () (abort-to-prompt 'foo)) + (lambda (k) #f)) + #t)) + + (pass-if "drop with RA, normal exit" + (begin + (letrec ((test (lambda () + (call-with-prompt + 'foo + (lambda () #f) + (lambda (k) #f))))) + (test)) + #t)) + + (pass-if "drop with RA, nonlocal exit" + (begin + (letrec ((test (lambda () + (call-with-prompt + 'foo + (lambda () (abort-to-prompt 'foo) #f) + (lambda (k) #f))))) + (test)) + #t))) + + (define fl (make-fluid)) (fluid-set! fl 0) From 56dbc8a89958fcc401b0980ffcd0047f20470cd3 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 29 Mar 2011 11:40:05 +0200 Subject: [PATCH 143/183] rewrite ensure-writable-dir to not be racy * module/system/base/compile.scm (ensure-writable-dir): Rewrite to not be racy. --- module/system/base/compile.scm | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 7d46713b2..1b6e73f32 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -68,16 +68,27 @@ x (lookup-language x))) -;; Throws an exception if `dir' is not writable. The double-stat is OK, -;; as this is only used during compilation. +;; Throws an exception if `dir' is not writable. The mkdir occurs +;; before the check, so that we avoid races (possibly due to parallel +;; compilation). +;; (define (ensure-writable-dir dir) - (if (file-exists? dir) - (if (access? dir W_OK) - #t - (error "directory not writable" dir)) - (begin - (ensure-writable-dir (dirname dir)) - (mkdir dir)))) + (catch 'system-error + (lambda () + (mkdir dir)) + (lambda (k subr fmt args rest) + (let ((errno (and (pair? rest) (car rest)))) + (cond + ((eqv? errno EEXIST) + (let ((st (stat dir))) + (if (or (not (eq? (stat:type st) 'directory)) + (not (access? dir W_OK))) + (error "directory not writable" dir)))) + ((eqv? errno ENOENT) + (ensure-writable-dir (dirname dir)) + (ensure-writable-dir dir)) + (else + (throw k subr fmt args rest))))))) ;;; This function is among the trickiest I've ever written. I tried many ;;; variants. In the end, simple is best, of course. From 2460274d360d36bc758b763a1bbb1dc2cb85a87b Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 29 Mar 2011 12:18:20 +0200 Subject: [PATCH 144/183] document -q, repl options * doc/ref/scheme-scripts.texi (Invoking Guile): Document -q. * doc/ref/scheme-using.texi (Init File): New section, on .guile. (Readline): Link to Init File. (System Commands): Document the various REPL options, and repl-default-option-set!. --- doc/ref/scheme-scripts.texi | 5 ++++ doc/ref/scheme-using.texi | 54 +++++++++++++++++++++++++++++++++---- 2 files changed, 54 insertions(+), 5 deletions(-) diff --git a/doc/ref/scheme-scripts.texi b/doc/ref/scheme-scripts.texi index 5a6f494d1..0ad1becf3 100644 --- a/doc/ref/scheme-scripts.texi +++ b/doc/ref/scheme-scripts.texi @@ -196,6 +196,11 @@ interactive session. When executing a script with @code{-s} or Do not use the debugging VM engine, even when entering an interactive session. +@item -q +Do not the local initialization file, @code{.guile}. This option only +has an effect when running interactively; running scripts does not load +the @code{.guile} file. @xref{Init File}. + @item --listen[=@var{p}] While this program runs, listen on a local port or a path for REPL clients. If @var{p} starts with a number, it is assumed to be a local diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index a119d4218..7995c8c04 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2006, 2010 +@c Copyright (C) 2006, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -35,6 +35,7 @@ current language is @code{scheme}, and the current module is support for languages other than Scheme. @menu +* Init File:: * Readline:: * Value History:: * REPL Commands:: @@ -43,6 +44,22 @@ support for languages other than Scheme. @end menu +@node Init File +@subsection The Init File, @file{~/.guile} + +@cindex .guile +When run interactively, Guile will load a local initialization file from +@file{~/.guile}. This file should contain Scheme expressions for +evaluation. + +This facility lets the user customize their interactive Guile +environment, pulling in extra modules or parameterizing the REPL +implementation. + +To run Guile without loading the init file, use the @code{-q} +command-line option. + + @node Readline @subsection Readline @@ -58,10 +75,8 @@ scheme@@(guile-user)> (activate-readline) @end lisp It's a good idea to put these two lines (without the -@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file. Guile -reads this file when it starts up interactively, so anything in this -file has the same effect as if you type it in by hand at the -@code{scheme@@(guile-user)>} prompt. +@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file. +@xref{Init File}, for more on @file{.guile}. @node Value History @@ -410,6 +425,35 @@ List/show/set options. Quit this session. @end deffn +Current REPL options include: + +@table @code +@item compile-options +The options used when compiling expressions entered at the REPL. +@xref{Compilation}, for more on compilation options. +@item interp +Whether to interpret or compile expressions given at the REPL, if such a +choice is available. Off by default (indicating compilation). +@item prompt +A customized REPL prompt. @code{#f} by default, indicating the default +prompt. +@item value-history +Whether value history is on or not. @xref{Value History}. +@item on-error +What to do when an error happens. By default, @code{debug}, meaning to +enter the debugger. Other values include @code{backtrace}, to show a +backtrace without entering the debugger, or @code{report}, to simply +show a short error printout. +@end table + +Default values for REPL options may be set using +@code{repl-default-option-set!} from @code{(system repl common)}: + +@deffn {Scheme Procedure} repl-set-default-option! key value +Set the default value of a REPL option. This function is particularly +useful in a user's init file. @xref{Init File}. +@end deffn + @node Error Handling @subsection Error Handling From fb6df3ea137eabad25d70219da2c84282883b433 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 29 Mar 2011 12:38:18 +0200 Subject: [PATCH 145/183] fix error message on ,disassemble "non-procedure" * module/language/objcode/spec.scm (decompile-value): Don't assume that `error' will handle format strings appropriately. * module/system/repl/command.scm (disassemble): A more human error when you disassemble a non-procedure. Bug reported by Andrew Horton. --- module/language/objcode/spec.scm | 4 ++-- module/system/repl/command.scm | 6 +++++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm index bbd745412..7cc85b7f6 100644 --- a/module/language/objcode/spec.scm +++ b/module/language/objcode/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Lowlevel Intermediate Language -;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -71,7 +71,7 @@ ((objcode? x) (values x #f)) (else - (error "can't decompile ~A: not a program or objcode" x)))) + (error "Object for disassembly not a program or objcode" x)))) (define-language objcode #:title "Guile Object Code" diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 87ab993a5..109b533f8 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -465,7 +465,11 @@ Compile a file." (define-meta-command (disassemble repl (form)) "disassemble EXP Disassemble a compiled procedure." - (guile:disassemble (repl-eval repl (repl-parse repl form)))) + (let ((obj (repl-eval repl (repl-parse repl form)))) + (if (or (program? obj) (objcode? obj)) + (guile:disassemble obj) + (format #t "Argument to ,disassemble not a procedure or objcode: ~a~%" + obj)))) (define-meta-command (disassemble-file repl file) "disassemble-file FILE From 8cf49d836ff41838812cba1fd61bfce3fb877144 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 29 Mar 2011 13:21:44 +0200 Subject: [PATCH 146/183] fix compilation with libgc 7.0, 7.1 * configure.ac: Check for GC_pthread_exit and GC_pthread_cancel. * libguile/gen-scmconfig.c: Write HAVE_GC_PTHREAD_CANCEL and HAVE_GC_PTHREAD_EXIT into scmconfig.h. * libguile/pthread-threads.h (scm_i_pthread_exit, scm_i_pthread_cancel): Only redefine to their GC_pthread_* variants if we have those functions, which is not the case in libgc < 7.2. --- configure.ac | 2 +- libguile/gen-scmconfig.c | 12 ++++++++++++ libguile/pthread-threads.h | 11 +++++++++++ 3 files changed, 24 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index a254634b5..e5b83798a 100644 --- a/configure.ac +++ b/configure.ac @@ -1238,7 +1238,7 @@ save_LIBS="$LIBS" LIBS="$BDW_GC_LIBS $LIBS" CFLAGS="$BDW_GC_CFLAGS $CFLAGS" -AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active]) +AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel]) # Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not # declared, and has a different type (returning void instead of diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index 02633563d..97066b78e 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -318,6 +318,18 @@ main (int argc, char *argv[]) pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n", SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER); +#ifdef HAVE_GC_PTHREAD_CANCEL + pf ("#define SCM_HAVE_GC_PTHREAD_CANCEL 1 /* 0 or 1 */\n"); +#else + pf ("#define SCM_HAVE_GC_PTHREAD_CANCEL 0 /* 0 or 1 */\n"); +#endif + +#ifdef HAVE_GC_PTHREAD_EXIT + pf ("#define SCM_HAVE_GC_PTHREAD_EXIT 1 /* 0 or 1 */\n"); +#else + pf ("#define SCM_HAVE_GC_PTHREAD_EXIT 0 /* 0 or 1 */\n"); +#endif + pf ("\n\n/*** File system access ***/\n"); pf ("/* Define to 1 if `struct dirent64' is available. */\n"); diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h index c180af252..b5fff834d 100644 --- a/libguile/pthread-threads.h +++ b/libguile/pthread-threads.h @@ -38,8 +38,19 @@ #define scm_i_pthread_self pthread_self #define scm_i_pthread_create GC_pthread_create #define scm_i_pthread_detach GC_pthread_detach + +#if SCM_HAVE_GC_PTHREAD_EXIT #define scm_i_pthread_exit GC_pthread_exit +#else +#define scm_i_pthread_exit pthread_exit +#endif + +#if SCM_HAVE_GC_PTHREAD_CANCEL #define scm_i_pthread_cancel GC_pthread_cancel +#else +#define scm_i_pthread_cancel pthread_cancel +#endif + #define scm_i_pthread_cleanup_push pthread_cleanup_push #define scm_i_pthread_cleanup_pop pthread_cleanup_pop #define scm_i_sched_yield sched_yield From 572eef50c2d902d34427945dd504ba03af666e48 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 29 Mar 2011 17:41:31 +0200 Subject: [PATCH 147/183] fix prompt and abort with the boot evaluator * libguile/control.h: * libguile/control.c (scm_i_prompt_pop_abort_args_x): Take a VM instead of a prompt, given that it's the VM's registers that record the abort arguments, not the prompt registers (which actually point right below the abort values). * libguile/eval.c (eval): * libguile/throw.c (pre_init_catch): Pass the vm instead of a prompt. --- libguile/control.c | 8 ++++---- libguile/control.h | 4 ++-- libguile/eval.c | 2 +- libguile/throw.c | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/libguile/control.c b/libguile/control.c index b6a558769..dc3fed250 100644 --- a/libguile/control.c +++ b/libguile/control.c @@ -55,18 +55,18 @@ scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip, /* Only to be called if the SCM_PROMPT_SETJMP returns 1 */ SCM -scm_i_prompt_pop_abort_args_x (SCM prompt) +scm_i_prompt_pop_abort_args_x (SCM vm) { size_t i, n; SCM vals = SCM_EOL; - n = scm_to_size_t (SCM_PROMPT_REGISTERS (prompt)->sp[0]); + n = scm_to_size_t (SCM_VM_DATA (vm)->sp[0]); for (i = 0; i < n; i++) - vals = scm_cons (SCM_PROMPT_REGISTERS (prompt)->sp[-(i + 1)], vals); + vals = scm_cons (SCM_VM_DATA (vm)->sp[-(i + 1)], vals); /* The abort did reset the VM's registers, but then these values were pushed on; so we need to pop them ourselves. */ - SCM_VM_DATA (scm_the_vm ())->sp -= n + 1; + SCM_VM_DATA (vm)->sp -= n + 1; /* FIXME NULLSTACK */ return vals; diff --git a/libguile/control.h b/libguile/control.h index bbc4c2099..2167ffa08 100644 --- a/libguile/control.h +++ b/libguile/control.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2010 Free Software Foundation, Inc. +/* Copyright (C) 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -46,7 +46,7 @@ SCM_INTERNAL SCM scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 escape_only_p, scm_t_int64 vm_cookie, SCM winds); -SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (SCM prompt); +SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (SCM vm); SCM_INTERNAL void scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie) SCM_NORETURN; diff --git a/libguile/eval.c b/libguile/eval.c index e66071410..164aadd70 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -424,7 +424,7 @@ eval (SCM x, SCM env) { /* The prompt exited nonlocally. */ proc = handler; - args = scm_i_prompt_pop_abort_args_x (prompt); + args = scm_i_prompt_pop_abort_args_x (scm_the_vm ()); goto apply_proc; } diff --git a/libguile/throw.c b/libguile/throw.c index 750e6a286..9c293516d 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -467,7 +467,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) if (SCM_PROMPT_SETJMP (prompt)) { /* nonlocal exit */ - SCM args = scm_i_prompt_pop_abort_args_x (prompt); + SCM args = scm_i_prompt_pop_abort_args_x (vm); /* cdr past the continuation */ return scm_apply_0 (handler, scm_cdr (args)); } From 443f25dcff49f0a920d4149e29bcb3ae9f64ee02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 29 Mar 2011 23:35:24 +0200 Subject: [PATCH 148/183] Fix `procedure->pointer' for functions returning `void'. * libguile/foreign.c (unpack): Handle `FFI_TYPE_VOID'. * test-suite/tests/foreign.test ("procedure->pointer")["procedures returning void"]: New test. Reported by Tristan Colgate . --- libguile/foreign.c | 3 +++ test-suite/tests/foreign.test | 10 ++++++++++ 2 files changed, 13 insertions(+) diff --git a/libguile/foreign.c b/libguile/foreign.c index 494ab5b4c..dbfba8770 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -905,6 +905,9 @@ unpack (const ffi_type *type, void *loc, SCM x) SCM_VALIDATE_POINTER (1, x); *(void **) loc = SCM_POINTER_VALUE (x); break; + case FFI_TYPE_VOID: + /* Do nothing. */ + break; default: abort (); } diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 3ff232eb2..93e5fe1ca 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -225,6 +225,16 @@ (arg3 (map (cut / <> 4.0) (iota 123 100 4)))) (equal? (map proc arg1 arg2 arg3) (map proc* arg1 arg2 arg3))) + (throw 'unresolved))) + + (pass-if "procedures returning void" + (if (defined? 'procedure->pointer) + (let* ((called? #f) + (proc (lambda () (set! called? #t))) + (pointer (procedure->pointer void proc '())) + (proc* (pointer->procedure void pointer '()))) + (proc*) + called?) (throw 'unresolved)))) From 4000d0641f8a2282a9c52eea33ad91c76625d906 Mon Sep 17 00:00:00 2001 From: Michael Gran Date: Tue, 29 Mar 2011 21:25:04 -0700 Subject: [PATCH 149/183] check for GC_allow_register_threads This is not present in earlier versions of BDW-GC * configure.ac: check for GC_allow_register_threads * libguile/threads.c (scm_i_init_thread_for_guile): Only call GC_allow_register_threads if it is present. --- configure.ac | 2 +- libguile/threads.c | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index e5b83798a..4fc25536b 100644 --- a/configure.ac +++ b/configure.ac @@ -1238,7 +1238,7 @@ save_LIBS="$LIBS" LIBS="$BDW_GC_LIBS $LIBS" CFLAGS="$BDW_GC_CFLAGS $CFLAGS" -AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel]) +AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel GC_allow_register_threads]) # Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not # declared, and has a different type (returning void instead of diff --git a/libguile/threads.c b/libguile/threads.c index ad5bbe19f..8dc3414dc 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -772,8 +772,10 @@ scm_i_init_thread_for_guile (struct GC_stack_base *base, SCM parent) */ scm_i_init_guile (base); +#ifdef HAVE_GC_ALLOW_REGISTER_THREADS /* Allow other threads to come in later. */ GC_allow_register_threads (); +#endif scm_i_pthread_mutex_unlock (&scm_i_init_mutex); } From 653ccd78fa6770c692f5a737ad70de5aedbfcc7f Mon Sep 17 00:00:00 2001 From: Michael Gran Date: Tue, 29 Mar 2011 21:27:54 -0700 Subject: [PATCH 150/183] don't GC unregister null thread GC_unregister_my_thread is only supposed to be called from a thread other than the main thread, so, it should never be called when the system is compiled with null threads. * libguile/threads.c (on_thread_exit)[SCM_USE_NULL_THREADS]: don't call GC_unregister_my_thread --- libguile/threads.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libguile/threads.c b/libguile/threads.c index 8dc3414dc..d81f4f4ef 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -720,7 +720,9 @@ on_thread_exit (void *v) scm_i_pthread_setspecific (scm_i_thread_key, NULL); +#if !SCM_USE_NULL_THREADS GC_unregister_my_thread (); +#endif } static scm_i_pthread_once_t init_thread_key_once = SCM_I_PTHREAD_ONCE_INIT; From e309f3bf9ee910c4772353ca3ff95f6f4ef466b5 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 24 Mar 2011 20:20:14 +0100 Subject: [PATCH 151/183] with-continuation-barrier calls exit(3) _after_ unwinding * libguile/continuations.c (scm_handler, c_handler) (scm_c_with_continuation_barrier, scm_with_continuation_barrier): Instead of calling scm_handle_by_message_noexit in the pre-unwind handler, roll our own exception printing in the pre-unwind, and do to exit()-on-quit in the post-unwind handler. This lets the stack unwind at exit-time so that pending dynwinds run. * test-suite/tests/continuations.test ("continuations"): Add a test. --- libguile/continuations.c | 67 +++++++++++++++++++++++++++-- test-suite/tests/continuations.test | 13 +++++- 2 files changed, 76 insertions(+), 4 deletions(-) diff --git a/libguile/continuations.c b/libguile/continuations.c index dc6850e05..7d56c2a59 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -460,6 +460,45 @@ scm_i_with_continuation_barrier (scm_t_catch_body body, return result; } + + +static int +should_print_backtrace (SCM tag, SCM stack) +{ + return SCM_BACKTRACE_P + && scm_is_true (stack) + && scm_initialized_p + /* It's generally not useful to print backtraces for errors reading + or expanding code in these fallback catch statements. */ + && !scm_is_eq (tag, scm_from_latin1_symbol ("read-error")) + && !scm_is_eq (tag, scm_from_latin1_symbol ("syntax-error")); +} + +static void +print_exception_and_backtrace (SCM port, SCM tag, SCM args) +{ + SCM stack, frame; + + /* We get here via a throw to a catch-all. In that case there is the + throw frame active, and this catch closure, so narrow by two + frames. */ + stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2))); + frame = scm_is_true (stack) ? scm_stack_ref (stack, SCM_INUM0) : SCM_BOOL_F; + + if (should_print_backtrace (tag, stack)) + { + scm_puts ("Backtrace:\n", port); + scm_display_backtrace_with_highlights (stack, port, + SCM_BOOL_F, SCM_BOOL_F, + SCM_EOL); + scm_newline (port); + } + + scm_print_exception (port, frame, tag, args); +} + + + struct c_data { void *(*func) (void *); void *data; @@ -477,11 +516,27 @@ c_body (void *d) static SCM c_handler (void *d, SCM tag, SCM args) { - struct c_data *data = (struct c_data *)d; + struct c_data *data; + + /* If TAG is `quit', exit() the process. */ + if (scm_is_eq (tag, scm_from_latin1_symbol ("quit"))) + exit (scm_exit_status (args)); + + data = (struct c_data *)d; data->result = NULL; return SCM_UNSPECIFIED; } +static SCM +pre_unwind_handler (void *error_port, SCM tag, SCM args) +{ + /* Print the exception unless TAG is `quit'. */ + if (!scm_is_eq (tag, scm_from_latin1_symbol ("quit"))) + print_exception_and_backtrace (PTR2SCM (error_port), tag, args); + + return SCM_UNSPECIFIED; +} + void * scm_c_with_continuation_barrier (void *(*func) (void *), void *data) { @@ -490,7 +545,8 @@ scm_c_with_continuation_barrier (void *(*func) (void *), void *data) c_data.data = data; scm_i_with_continuation_barrier (c_body, &c_data, c_handler, &c_data, - scm_handle_by_message_noexit, NULL); + pre_unwind_handler, + SCM2PTR (scm_current_error_port ())); return c_data.result; } @@ -508,6 +564,10 @@ scm_body (void *d) static SCM scm_handler (void *d, SCM tag, SCM args) { + /* Print a message. Note that if TAG is `quit', this will exit() the + process. */ + scm_handle_by_message_noexit (NULL, tag, args); + return SCM_BOOL_F; } @@ -529,7 +589,8 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0, scm_data.proc = proc; return scm_i_with_continuation_barrier (scm_body, &scm_data, scm_handler, &scm_data, - scm_handle_by_message_noexit, NULL); + pre_unwind_handler, + SCM2PTR (scm_current_error_port ())); } #undef FUNC_NAME diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test index f6db40e58..a436b90d4 100644 --- a/test-suite/tests/continuations.test +++ b/test-suite/tests/continuations.test @@ -1,7 +1,7 @@ ;;;; -*- scheme -*- ;;;; continuations.test --- test suite for continutations ;;;; -;;;; Copyright (C) 2003, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006, 2009, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -80,6 +80,17 @@ (error "Catch me if you can!"))))))))) handled)) + (pass-if "exit unwinds dynwinds inside a continuation barrier" + (let ((s (with-error-to-string + (lambda () + (with-continuation-barrier + (lambda () + (dynamic-wind + (lambda () #f) + (lambda () (exit 1)) + (lambda () (throw 'abcde))))))))) + (and (string-contains s "abcde") #t))) + (with-debugging-evaluator (pass-if "make a stack from a continuation" From 0f1fd214f184a998a3d8e1580b7acb9d02dc879b Mon Sep 17 00:00:00 2001 From: Michael Gran Date: Wed, 30 Mar 2011 20:42:37 -0700 Subject: [PATCH 152/183] More descriptive error for dynamic-pointer * libguile/dynl.c (sysdep_dynl_value): Failure to find a symbol is not an error, so raise our own, more appropriate error. * test-suite/tests/foreign.test ("dynamic-pointer"): Add a test. --- libguile/dynl.c | 5 ++--- test-suite/tests/foreign.test | 8 ++++++++ 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/libguile/dynl.c b/libguile/dynl.c index 2484ddaa0..a2ae6e267 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -115,9 +115,8 @@ sysdep_dynl_value (const char *symb, void *handle, const char *subr) fptr = lt_dlsym ((lt_dlhandle) handle, symb); if (!fptr) - { - scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); - } + scm_misc_error (subr, "Symbol not found: ~a", + scm_list_1 (scm_from_locale_string (symb))); return fptr; } diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 93e5fe1ca..1353e7dbb 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -27,6 +27,14 @@ #:use-module (srfi srfi-26) #:use-module (test-suite lib)) + +(with-test-prefix "dynamic-pointer" + + (pass-if-exception + "error message" + '(misc-error . "^Symbol not found") + (dynamic-func "does_not_exist___" (dynamic-link)))) + (with-test-prefix "null pointer" From f929b9e5ec39391bee1d0ce256b59b0c610caa25 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Mar 2011 13:23:27 +0200 Subject: [PATCH 153/183] allow definitions in with-syntax body * module/ice-9/psyntax.scm (with-syntax): Allow definitions in the body, as seems to be suggested by the R6RS. * test-suite/tests/syncase.test ("with-syntax"): Add test. * module/ice-9/psyntax-pp.scm: Regenerate. --- module/ice-9/psyntax-pp.scm | 130 ++++++++++++++++++++++++---------- module/ice-9/psyntax.scm | 7 +- test-suite/tests/syncase.test | 7 ++ 3 files changed, 105 insertions(+), 39 deletions(-) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index fb862d019..5c26e96c3 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -37,16 +37,10 @@ (begin (#{andmap\ 225}# #{first\ 203}# #{rest\ 204}#)))))))))) (begin - (let ((#{make-primitive-ref\ 244}# (if #f #f)) - (#{fx+\ 283}# (if #f #f)) + (let ((#{fx+\ 283}# (if #f #f)) (#{fx-\ 285}# (if #f #f)) (#{fx=\ 287}# (if #f #f)) - (#{fx<\ 289}# (if #f #f)) - (#{set-syntax-object-expression!\ 354}# - (if #f #f)) - (#{set-syntax-object-wrap!\ 356}# (if #f #f)) - (#{set-syntax-object-module!\ 358}# (if #f #f)) - (#{ribcage?\ 400}# (if #f #f))) + (#{fx<\ 289}# (if #f #f))) (letrec* ((#{make-void\ 240}# (lambda (#{src\ 750}#) @@ -7718,6 +7712,10 @@ '(#(syntax-object #f ((top) + #(ribcage + () + () + ()) #(ribcage #(k) #((top)) @@ -8927,32 +8925,27 @@ (cons #{vars\ 2791}# #{ls\ 2792}#)))))))) (begin (#{lvl\ 2790}# #{vars\ 2784}# '() '(()))))))) (begin - (set! #{make-primitive-ref\ 244}# - (lambda (#{src\ 756}# #{name\ 757}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 2) - #{src\ 756}# - #{name\ 757}#))) + (lambda (#{src\ 756}# #{name\ 757}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 2) + #{src\ 756}# + #{name\ 757}#)) + (lambda (#{x\ 1134}# #{update\ 1135}#) + (vector-set! #{x\ 1134}# 1 #{update\ 1135}#)) + (lambda (#{x\ 1138}# #{update\ 1139}#) + (vector-set! #{x\ 1138}# 2 #{update\ 1139}#)) + (lambda (#{x\ 1142}# #{update\ 1143}#) + (vector-set! #{x\ 1142}# 3 #{update\ 1143}#)) + (lambda (#{x\ 1223}#) + (if (vector? #{x\ 1223}#) + (if (= (vector-length #{x\ 1223}#) 4) + (eq? (vector-ref #{x\ 1223}# 0) 'ribcage) + #f) + #f)) (set! #{fx+\ 283}# +) (set! #{fx-\ 285}# -) (set! #{fx=\ 287}# =) (set! #{fx<\ 289}# <) - (set! #{set-syntax-object-expression!\ 354}# - (lambda (#{x\ 1134}# #{update\ 1135}#) - (vector-set! #{x\ 1134}# 1 #{update\ 1135}#))) - (set! #{set-syntax-object-wrap!\ 356}# - (lambda (#{x\ 1138}# #{update\ 1139}#) - (vector-set! #{x\ 1138}# 2 #{update\ 1139}#))) - (set! #{set-syntax-object-module!\ 358}# - (lambda (#{x\ 1142}# #{update\ 1143}#) - (vector-set! #{x\ 1142}# 3 #{update\ 1143}#))) - (set! #{ribcage?\ 400}# - (lambda (#{x\ 1223}#) - (if (vector? #{x\ 1223}#) - (if (= (vector-length #{x\ 1223}#) 4) - (eq? (vector-ref #{x\ 1223}# 0) 'ribcage) - #f) - #f))) (begin (#{global-extend\ 376}# 'local-syntax @@ -14515,7 +14508,7 @@ (@apply (lambda (#{e1\ 4203}# #{e2\ 4204}#) (cons '#(syntax-object - begin + let ((top) #(ribcage #(e1 e2) @@ -14524,7 +14517,7 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) - (cons #{e1\ 4203}# #{e2\ 4204}#))) + (cons '() (cons #{e1\ 4203}# #{e2\ 4204}#)))) #{tmp\ 4200}#) (let ((#{tmp\ 4206}# ($sc-dispatch @@ -14550,7 +14543,7 @@ '() (list #{out\ 4211}# (cons '#(syntax-object - begin + let ((top) #(ribcage #(out in e1 e2) @@ -14559,7 +14552,9 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4198"))) (hygiene guile)) - (cons #{e1\ 4213}# #{e2\ 4214}#))))) + (cons '() + (cons #{e1\ 4213}# + #{e2\ 4214}#)))))) #{tmp\ 4206}#) (let ((#{tmp\ 4216}# ($sc-dispatch @@ -14595,7 +14590,7 @@ '() (list #{out\ 4221}# (cons '#(syntax-object - begin + let ((top) #(ribcage #(out in e1 e2) @@ -14610,7 +14605,9 @@ #((top)) #("i4198"))) (hygiene guile)) - (cons #{e1\ 4223}# #{e2\ 4224}#))))) + (cons '() + (cons #{e1\ 4223}# + #{e2\ 4224}#)))))) #{tmp\ 4216}#) (syntax-violation #f @@ -15006,6 +15003,7 @@ (list '#(syntax-object let ((top) + #(ribcage () () ()) #(ribcage #(body binding) #((top) (top)) @@ -15104,6 +15102,7 @@ (list '#(syntax-object let ((top) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15131,6 +15130,7 @@ '#(syntax-object doloop ((top) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15161,6 +15161,7 @@ (list '#(syntax-object if ((top) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15188,6 +15189,7 @@ (list '#(syntax-object not ((top) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15221,6 +15223,7 @@ (cons '#(syntax-object begin ((top) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15255,6 +15258,10 @@ (list (cons '#(syntax-object doloop ((top) + #(ribcage + () + () + ()) #(ribcage #(step) #((top)) @@ -15304,6 +15311,7 @@ #(e1 e2) #((top) (top)) #("i4336" "i4337")) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15335,6 +15343,7 @@ #(e1 e2) #((top) (top)) #("i4336" "i4337")) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15369,6 +15378,7 @@ #(e1 e2) #((top) (top)) #("i4336" "i4337")) + #(ribcage () () ()) #(ribcage #(step) #((top)) @@ -15407,6 +15417,10 @@ #((top) (top)) #("i4336" "i4337")) + #(ribcage + () + () + ()) #(ribcage #(step) #((top)) @@ -15449,6 +15463,10 @@ #((top) (top)) #("i4336" "i4337")) + #(ribcage + () + () + ()) #(ribcage #(step) #((top)) @@ -15493,6 +15511,10 @@ (top)) #("i4336" "i4337")) + #(ribcage + () + () + ()) #(ribcage #(step) #((top)) @@ -16596,6 +16618,7 @@ #(dy) #((top)) #("i4445")) + #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) @@ -16644,6 +16667,7 @@ #(dy) #((top)) #("i4445")) + #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) @@ -16688,6 +16712,7 @@ #(dy) #((top)) #("i4445")) + #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) @@ -16737,6 +16762,7 @@ #(stuff) #((top)) #("i4454")) + #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) @@ -16785,6 +16811,7 @@ #(stuff) #((top)) #("i4457")) + #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) @@ -16828,6 +16855,7 @@ #(_) #((top)) #("i4459")) + #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) @@ -16914,6 +16942,7 @@ (cons '#(syntax-object "append" ((top) + #(ribcage () () ()) #(ribcage #(p) #((top)) @@ -16964,6 +16993,7 @@ (cons '#(syntax-object "append" ((top) + #(ribcage () () ()) #(ribcage #(p y) #((top) (top)) @@ -17142,6 +17172,7 @@ (list '#(syntax-object "list->vector" ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4543}#) #((m4544 top)) @@ -17202,6 +17233,7 @@ (cons '#(syntax-object "vector" ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4516}#) #((m4517 top)) @@ -17301,6 +17333,7 @@ (cons '#(syntax-object list ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4558}#) #((m4559 top)) @@ -17371,6 +17404,7 @@ (list '#(syntax-object cons ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4578}# #{\ g4577}#) @@ -17441,6 +17475,7 @@ (cons '#(syntax-object append ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4590}#) #((m4591 top)) @@ -17502,6 +17537,7 @@ (cons '#(syntax-object vector ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4602}#) #((m4603 top)) @@ -17558,6 +17594,7 @@ (list '#(syntax-object list->vector ((top) + #(ribcage () () ()) #(ribcage #(#{\ g4614}#) #((m4615 top)) @@ -17665,6 +17702,7 @@ (cons '#(syntax-object begin ((top) + #(ribcage () () ()) #(ribcage #(exp) #((top)) @@ -17730,6 +17768,7 @@ (list '#(syntax-object include ((top) + #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i4671")) #(ribcage () () ()) #(ribcage () () ()) @@ -18092,6 +18131,7 @@ #("i4726" "i4727" "i4728")) + #(ribcage () () ()) #(ribcage #(rest) #((top)) @@ -18126,6 +18166,10 @@ #("i4726" "i4727" "i4728")) + #(ribcage + () + () + ()) #(ribcage #(rest) #((top)) @@ -18172,6 +18216,10 @@ #("i4726" "i4727" "i4728")) + #(ribcage + () + () + ()) #(ribcage #(rest) #((top)) @@ -18220,6 +18268,10 @@ #("i4726" "i4727" "i4728")) + #(ribcage + () + () + ()) #(ribcage #(rest) #((top)) @@ -18270,6 +18322,10 @@ #("i4726" "i4727" "i4728")) + #(ribcage + () + () + ()) #(ribcage #(rest) #((top)) @@ -18320,6 +18376,7 @@ (list '#(syntax-object let ((top) + #(ribcage () () ()) #(ribcage #(body) #((top)) #("i4693")) #(ribcage #(e m1 m2) @@ -18331,6 +18388,7 @@ (list (list '#(syntax-object t ((top) + #(ribcage () () ()) #(ribcage #(body) #((top)) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index f5a7305b6..426640095 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -2632,12 +2632,13 @@ (lambda (x) (syntax-case x () ((_ () e1 e2 ...) - #'(begin e1 e2 ...)) + #'(let () e1 e2 ...)) ((_ ((out in)) e1 e2 ...) - #'(syntax-case in () (out (begin e1 e2 ...)))) + #'(syntax-case in () + (out (let () e1 e2 ...)))) ((_ ((out in) ...) e1 e2 ...) #'(syntax-case (list in ...) () - ((out ...) (begin e1 e2 ...))))))) + ((out ...) (let () e1 e2 ...))))))) (define-syntax syntax-rules (lambda (x) diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test index 84f1cfc8b..6183df813 100644 --- a/test-suite/tests/syncase.test +++ b/test-suite/tests/syncase.test @@ -68,6 +68,13 @@ ((alist ((key val) ...)) (list '(key . val) ...)))) +(with-test-prefix "with-syntax" + (pass-if "definitions allowed in body" + (equal? (with-syntax ((a 23)) + (define b #'a) + (syntax->datum b)) + 23))) + (with-test-prefix "tail patterns" (with-test-prefix "at the outermost level" (pass-if "non-tail invocation" From d8f699e8eb6e5dfdbaf38e8bea15711b5b29c417 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Mar 2011 13:29:41 +0200 Subject: [PATCH 154/183] inline fxops in psyntax * module/ice-9/psyntax.scm (fx+, fx-, fx=, fx<): Given our lame lack of an inliner, inline these manually with identifier syntax. * module/ice-9/psyntax-pp.scm: Regenerate. --- module/ice-9/psyntax-pp.scm | 30451 +++++++++++++++++----------------- module/ice-9/psyntax.scm | 8 +- 2 files changed, 15180 insertions(+), 15279 deletions(-) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 5c26e96c3..53d591295 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -37,11808 +37,1561 @@ (begin (#{andmap\ 225}# #{first\ 203}# #{rest\ 204}#)))))))))) (begin - (let ((#{fx+\ 283}# (if #f #f)) - (#{fx-\ 285}# (if #f #f)) - (#{fx=\ 287}# (if #f #f)) - (#{fx<\ 289}# (if #f #f))) - (letrec* - ((#{make-void\ 240}# - (lambda (#{src\ 750}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 0) - #{src\ 750}#))) - (#{make-const\ 242}# - (lambda (#{src\ 752}# #{exp\ 753}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 1) - #{src\ 752}# - #{exp\ 753}#))) - (#{make-lexical-ref\ 246}# - (lambda (#{src\ 760}# #{name\ 761}# #{gensym\ 762}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - #{src\ 760}# - #{name\ 761}# - #{gensym\ 762}#))) - (#{make-lexical-set\ 248}# - (lambda (#{src\ 766}# - #{name\ 767}# - #{gensym\ 768}# - #{exp\ 769}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 4) - #{src\ 766}# - #{name\ 767}# - #{gensym\ 768}# - #{exp\ 769}#))) - (#{make-module-ref\ 250}# - (lambda (#{src\ 774}# - #{mod\ 775}# - #{name\ 776}# - #{public?\ 777}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #{src\ 774}# - #{mod\ 775}# - #{name\ 776}# - #{public?\ 777}#))) - (#{make-module-set\ 252}# - (lambda (#{src\ 782}# - #{mod\ 783}# - #{name\ 784}# - #{public?\ 785}# - #{exp\ 786}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 6) - #{src\ 782}# - #{mod\ 783}# - #{name\ 784}# - #{public?\ 785}# - #{exp\ 786}#))) - (#{make-toplevel-ref\ 254}# - (lambda (#{src\ 792}# #{name\ 793}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #{src\ 792}# - #{name\ 793}#))) - (#{make-toplevel-set\ 256}# - (lambda (#{src\ 796}# #{name\ 797}# #{exp\ 798}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 8) - #{src\ 796}# - #{name\ 797}# - #{exp\ 798}#))) - (#{make-toplevel-define\ 258}# - (lambda (#{src\ 802}# #{name\ 803}# #{exp\ 804}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 9) - #{src\ 802}# - #{name\ 803}# - #{exp\ 804}#))) - (#{make-conditional\ 260}# - (lambda (#{src\ 808}# - #{test\ 809}# - #{consequent\ 810}# - #{alternate\ 811}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 10) - #{src\ 808}# - #{test\ 809}# - #{consequent\ 810}# - #{alternate\ 811}#))) - (#{make-application\ 262}# - (lambda (#{src\ 816}# #{proc\ 817}# #{args\ 818}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - #{src\ 816}# - #{proc\ 817}# - #{args\ 818}#))) - (#{make-sequence\ 264}# - (lambda (#{src\ 822}# #{exps\ 823}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 12) - #{src\ 822}# - #{exps\ 823}#))) - (#{make-lambda\ 266}# - (lambda (#{src\ 826}# #{meta\ 827}# #{body\ 828}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - #{src\ 826}# - #{meta\ 827}# - #{body\ 828}#))) - (#{make-lambda-case\ 268}# - (lambda (#{src\ 832}# - #{req\ 833}# - #{opt\ 834}# - #{rest\ 835}# - #{kw\ 836}# - #{inits\ 837}# - #{gensyms\ 838}# - #{body\ 839}# - #{alternate\ 840}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - #{src\ 832}# - #{req\ 833}# - #{opt\ 834}# - #{rest\ 835}# - #{kw\ 836}# - #{inits\ 837}# - #{gensyms\ 838}# - #{body\ 839}# - #{alternate\ 840}#))) - (#{make-let\ 270}# - (lambda (#{src\ 850}# - #{names\ 851}# - #{gensyms\ 852}# - #{vals\ 853}# - #{body\ 854}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 15) - #{src\ 850}# - #{names\ 851}# - #{gensyms\ 852}# - #{vals\ 853}# - #{body\ 854}#))) - (#{make-letrec\ 272}# - (lambda (#{src\ 860}# - #{in-order?\ 861}# - #{names\ 862}# - #{gensyms\ 863}# - #{vals\ 864}# - #{body\ 865}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 16) - #{src\ 860}# - #{in-order?\ 861}# - #{names\ 862}# - #{gensyms\ 863}# - #{vals\ 864}# - #{body\ 865}#))) - (#{make-dynlet\ 274}# - (lambda (#{src\ 872}# - #{fluids\ 873}# - #{vals\ 874}# - #{body\ 875}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 17) - #{src\ 872}# - #{fluids\ 873}# - #{vals\ 874}# - #{body\ 875}#))) - (#{lambda?\ 277}# - (lambda (#{x\ 880}#) - (if (struct? #{x\ 880}#) - (eq? (struct-vtable #{x\ 880}#) - (vector-ref %expanded-vtables 13)) - #f))) - (#{lambda-meta\ 279}# - (lambda (#{x\ 884}#) (struct-ref #{x\ 884}# 1))) - (#{set-lambda-meta!\ 281}# - (lambda (#{x\ 886}# #{v\ 887}#) - (struct-set! #{x\ 886}# 1 #{v\ 887}#))) - (#{top-level-eval-hook\ 291}# - (lambda (#{x\ 890}# #{mod\ 891}#) - (primitive-eval #{x\ 890}#))) - (#{local-eval-hook\ 293}# - (lambda (#{x\ 894}# #{mod\ 895}#) - (primitive-eval #{x\ 894}#))) - (#{put-global-definition-hook\ 296}# - (lambda (#{symbol\ 898}# #{type\ 899}# #{val\ 900}#) - (module-define! - (current-module) - #{symbol\ 898}# - (make-syntax-transformer - #{symbol\ 898}# - #{type\ 899}# - #{val\ 900}#)))) - (#{get-global-definition-hook\ 298}# - (lambda (#{symbol\ 904}# #{module\ 905}#) + (letrec* + ((#{make-void\ 240}# + (lambda (#{src\ 798}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 0) + #{src\ 798}#))) + (#{make-const\ 242}# + (lambda (#{src\ 800}# #{exp\ 801}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 1) + #{src\ 800}# + #{exp\ 801}#))) + (#{make-lexical-ref\ 246}# + (lambda (#{src\ 808}# #{name\ 809}# #{gensym\ 810}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 3) + #{src\ 808}# + #{name\ 809}# + #{gensym\ 810}#))) + (#{make-lexical-set\ 248}# + (lambda (#{src\ 814}# + #{name\ 815}# + #{gensym\ 816}# + #{exp\ 817}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 4) + #{src\ 814}# + #{name\ 815}# + #{gensym\ 816}# + #{exp\ 817}#))) + (#{make-module-ref\ 250}# + (lambda (#{src\ 822}# + #{mod\ 823}# + #{name\ 824}# + #{public?\ 825}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 5) + #{src\ 822}# + #{mod\ 823}# + #{name\ 824}# + #{public?\ 825}#))) + (#{make-module-set\ 252}# + (lambda (#{src\ 830}# + #{mod\ 831}# + #{name\ 832}# + #{public?\ 833}# + #{exp\ 834}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 6) + #{src\ 830}# + #{mod\ 831}# + #{name\ 832}# + #{public?\ 833}# + #{exp\ 834}#))) + (#{make-toplevel-ref\ 254}# + (lambda (#{src\ 840}# #{name\ 841}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 7) + #{src\ 840}# + #{name\ 841}#))) + (#{make-toplevel-set\ 256}# + (lambda (#{src\ 844}# #{name\ 845}# #{exp\ 846}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 8) + #{src\ 844}# + #{name\ 845}# + #{exp\ 846}#))) + (#{make-toplevel-define\ 258}# + (lambda (#{src\ 850}# #{name\ 851}# #{exp\ 852}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 9) + #{src\ 850}# + #{name\ 851}# + #{exp\ 852}#))) + (#{make-conditional\ 260}# + (lambda (#{src\ 856}# + #{test\ 857}# + #{consequent\ 858}# + #{alternate\ 859}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 10) + #{src\ 856}# + #{test\ 857}# + #{consequent\ 858}# + #{alternate\ 859}#))) + (#{make-application\ 262}# + (lambda (#{src\ 864}# #{proc\ 865}# #{args\ 866}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 11) + #{src\ 864}# + #{proc\ 865}# + #{args\ 866}#))) + (#{make-sequence\ 264}# + (lambda (#{src\ 870}# #{exps\ 871}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 12) + #{src\ 870}# + #{exps\ 871}#))) + (#{make-lambda\ 266}# + (lambda (#{src\ 874}# #{meta\ 875}# #{body\ 876}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 13) + #{src\ 874}# + #{meta\ 875}# + #{body\ 876}#))) + (#{make-lambda-case\ 268}# + (lambda (#{src\ 880}# + #{req\ 881}# + #{opt\ 882}# + #{rest\ 883}# + #{kw\ 884}# + #{inits\ 885}# + #{gensyms\ 886}# + #{body\ 887}# + #{alternate\ 888}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 14) + #{src\ 880}# + #{req\ 881}# + #{opt\ 882}# + #{rest\ 883}# + #{kw\ 884}# + #{inits\ 885}# + #{gensyms\ 886}# + #{body\ 887}# + #{alternate\ 888}#))) + (#{make-let\ 270}# + (lambda (#{src\ 898}# + #{names\ 899}# + #{gensyms\ 900}# + #{vals\ 901}# + #{body\ 902}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 15) + #{src\ 898}# + #{names\ 899}# + #{gensyms\ 900}# + #{vals\ 901}# + #{body\ 902}#))) + (#{make-letrec\ 272}# + (lambda (#{src\ 908}# + #{in-order?\ 909}# + #{names\ 910}# + #{gensyms\ 911}# + #{vals\ 912}# + #{body\ 913}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 16) + #{src\ 908}# + #{in-order?\ 909}# + #{names\ 910}# + #{gensyms\ 911}# + #{vals\ 912}# + #{body\ 913}#))) + (#{make-dynlet\ 274}# + (lambda (#{src\ 920}# + #{fluids\ 921}# + #{vals\ 922}# + #{body\ 923}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 17) + #{src\ 920}# + #{fluids\ 921}# + #{vals\ 922}# + #{body\ 923}#))) + (#{lambda?\ 277}# + (lambda (#{x\ 928}#) + (if (struct? #{x\ 928}#) + (eq? (struct-vtable #{x\ 928}#) + (vector-ref %expanded-vtables 13)) + #f))) + (#{lambda-meta\ 279}# + (lambda (#{x\ 932}#) (struct-ref #{x\ 932}# 1))) + (#{set-lambda-meta!\ 281}# + (lambda (#{x\ 934}# #{v\ 935}#) + (struct-set! #{x\ 934}# 1 #{v\ 935}#))) + (#{top-level-eval-hook\ 287}# + (lambda (#{x\ 938}# #{mod\ 939}#) + (primitive-eval #{x\ 938}#))) + (#{local-eval-hook\ 289}# + (lambda (#{x\ 942}# #{mod\ 943}#) + (primitive-eval #{x\ 942}#))) + (#{put-global-definition-hook\ 292}# + (lambda (#{symbol\ 946}# #{type\ 947}# #{val\ 948}#) + (module-define! + (current-module) + #{symbol\ 946}# + (make-syntax-transformer + #{symbol\ 946}# + #{type\ 947}# + #{val\ 948}#)))) + (#{get-global-definition-hook\ 294}# + (lambda (#{symbol\ 952}# #{module\ 953}#) + (begin + (if (if (not #{module\ 953}#) (current-module) #f) + (warn "module system is booted, we should have a module" + #{symbol\ 952}#)) (begin - (if (if (not #{module\ 905}#) (current-module) #f) - (warn "module system is booted, we should have a module" - #{symbol\ 904}#)) - (begin - (let ((#{v\ 911}# (module-variable - (if #{module\ 905}# - (resolve-module (cdr #{module\ 905}#)) - (current-module)) - #{symbol\ 904}#))) - (if #{v\ 911}# - (if (variable-bound? #{v\ 911}#) - (begin - (let ((#{val\ 916}# (variable-ref #{v\ 911}#))) - (if (macro? #{val\ 916}#) - (if (macro-type #{val\ 916}#) - (cons (macro-type #{val\ 916}#) - (macro-binding #{val\ 916}#)) + (let ((#{v\ 959}# (module-variable + (if #{module\ 953}# + (resolve-module (cdr #{module\ 953}#)) + (current-module)) + #{symbol\ 952}#))) + (if #{v\ 959}# + (if (variable-bound? #{v\ 959}#) + (begin + (let ((#{val\ 964}# (variable-ref #{v\ 959}#))) + (if (macro? #{val\ 964}#) + (if (macro-type #{val\ 964}#) + (cons (macro-type #{val\ 964}#) + (macro-binding #{val\ 964}#)) + #f) + #f))) + #f) + #f)))))) + (#{decorate-source\ 296}# + (lambda (#{e\ 968}# #{s\ 969}#) + (begin + (if (if (pair? #{e\ 968}#) #{s\ 969}# #f) + (set-source-properties! #{e\ 968}# #{s\ 969}#)) + #{e\ 968}#))) + (#{maybe-name-value!\ 298}# + (lambda (#{name\ 974}# #{val\ 975}#) + (if (#{lambda?\ 277}# #{val\ 975}#) + (begin + (let ((#{meta\ 979}# + (#{lambda-meta\ 279}# #{val\ 975}#))) + (if (not (assq 'name #{meta\ 979}#)) + (#{set-lambda-meta!\ 281}# + #{val\ 975}# + (cons (cons 'name #{name\ 974}#) #{meta\ 979}#)))))))) + (#{build-void\ 300}# + (lambda (#{source\ 980}#) + (#{make-void\ 240}# #{source\ 980}#))) + (#{build-application\ 302}# + (lambda (#{source\ 982}# + #{fun-exp\ 983}# + #{arg-exps\ 984}#) + (#{make-application\ 262}# + #{source\ 982}# + #{fun-exp\ 983}# + #{arg-exps\ 984}#))) + (#{build-conditional\ 304}# + (lambda (#{source\ 988}# + #{test-exp\ 989}# + #{then-exp\ 990}# + #{else-exp\ 991}#) + (#{make-conditional\ 260}# + #{source\ 988}# + #{test-exp\ 989}# + #{then-exp\ 990}# + #{else-exp\ 991}#))) + (#{build-dynlet\ 306}# + (lambda (#{source\ 996}# + #{fluids\ 997}# + #{vals\ 998}# + #{body\ 999}#) + (#{make-dynlet\ 274}# + #{source\ 996}# + #{fluids\ 997}# + #{vals\ 998}# + #{body\ 999}#))) + (#{build-lexical-reference\ 308}# + (lambda (#{type\ 1004}# + #{source\ 1005}# + #{name\ 1006}# + #{var\ 1007}#) + (#{make-lexical-ref\ 246}# + #{source\ 1005}# + #{name\ 1006}# + #{var\ 1007}#))) + (#{build-lexical-assignment\ 310}# + (lambda (#{source\ 1012}# + #{name\ 1013}# + #{var\ 1014}# + #{exp\ 1015}#) + (begin + (#{maybe-name-value!\ 298}# + #{name\ 1013}# + #{exp\ 1015}#) + (#{make-lexical-set\ 248}# + #{source\ 1012}# + #{name\ 1013}# + #{var\ 1014}# + #{exp\ 1015}#)))) + (#{analyze-variable\ 312}# + (lambda (#{mod\ 1020}# + #{var\ 1021}# + #{modref-cont\ 1022}# + #{bare-cont\ 1023}#) + (if (not #{mod\ 1020}#) + (#{bare-cont\ 1023}# #{var\ 1021}#) + (begin + (let ((#{kind\ 1030}# (car #{mod\ 1020}#)) + (#{mod\ 1031}# (cdr #{mod\ 1020}#))) + (if (eqv? #{kind\ 1030}# 'public) + (#{modref-cont\ 1022}# + #{mod\ 1031}# + #{var\ 1021}# + #t) + (if (eqv? #{kind\ 1030}# 'private) + (if (not (equal? + #{mod\ 1031}# + (module-name (current-module)))) + (#{modref-cont\ 1022}# + #{mod\ 1031}# + #{var\ 1021}# + #f) + (#{bare-cont\ 1023}# #{var\ 1021}#)) + (if (eqv? #{kind\ 1030}# 'bare) + (#{bare-cont\ 1023}# #{var\ 1021}#) + (if (eqv? #{kind\ 1030}# 'hygiene) + (if (if (not (equal? + #{mod\ 1031}# + (module-name (current-module)))) + (module-variable + (resolve-module #{mod\ 1031}#) + #{var\ 1021}#) #f) - #f))) - #f) - #f)))))) - (#{decorate-source\ 300}# - (lambda (#{e\ 920}# #{s\ 921}#) - (begin - (if (if (pair? #{e\ 920}#) #{s\ 921}# #f) - (set-source-properties! #{e\ 920}# #{s\ 921}#)) - #{e\ 920}#))) - (#{maybe-name-value!\ 302}# - (lambda (#{name\ 926}# #{val\ 927}#) - (if (#{lambda?\ 277}# #{val\ 927}#) - (begin - (let ((#{meta\ 931}# - (#{lambda-meta\ 279}# #{val\ 927}#))) - (if (not (assq 'name #{meta\ 931}#)) - (#{set-lambda-meta!\ 281}# - #{val\ 927}# - (cons (cons 'name #{name\ 926}#) #{meta\ 931}#)))))))) - (#{build-void\ 304}# - (lambda (#{source\ 932}#) - (#{make-void\ 240}# #{source\ 932}#))) - (#{build-application\ 306}# - (lambda (#{source\ 934}# - #{fun-exp\ 935}# - #{arg-exps\ 936}#) - (#{make-application\ 262}# - #{source\ 934}# - #{fun-exp\ 935}# - #{arg-exps\ 936}#))) - (#{build-conditional\ 308}# - (lambda (#{source\ 940}# - #{test-exp\ 941}# - #{then-exp\ 942}# - #{else-exp\ 943}#) - (#{make-conditional\ 260}# - #{source\ 940}# - #{test-exp\ 941}# - #{then-exp\ 942}# - #{else-exp\ 943}#))) - (#{build-dynlet\ 310}# - (lambda (#{source\ 948}# - #{fluids\ 949}# - #{vals\ 950}# - #{body\ 951}#) - (#{make-dynlet\ 274}# - #{source\ 948}# - #{fluids\ 949}# - #{vals\ 950}# - #{body\ 951}#))) - (#{build-lexical-reference\ 312}# - (lambda (#{type\ 956}# - #{source\ 957}# - #{name\ 958}# - #{var\ 959}#) - (#{make-lexical-ref\ 246}# - #{source\ 957}# - #{name\ 958}# - #{var\ 959}#))) - (#{build-lexical-assignment\ 314}# - (lambda (#{source\ 964}# - #{name\ 965}# - #{var\ 966}# - #{exp\ 967}#) - (begin - (#{maybe-name-value!\ 302}# - #{name\ 965}# - #{exp\ 967}#) - (#{make-lexical-set\ 248}# - #{source\ 964}# - #{name\ 965}# - #{var\ 966}# - #{exp\ 967}#)))) - (#{analyze-variable\ 316}# - (lambda (#{mod\ 972}# - #{var\ 973}# - #{modref-cont\ 974}# - #{bare-cont\ 975}#) - (if (not #{mod\ 972}#) - (#{bare-cont\ 975}# #{var\ 973}#) - (begin - (let ((#{kind\ 982}# (car #{mod\ 972}#)) - (#{mod\ 983}# (cdr #{mod\ 972}#))) - (if (eqv? #{kind\ 982}# 'public) - (#{modref-cont\ 974}# - #{mod\ 983}# - #{var\ 973}# - #t) - (if (eqv? #{kind\ 982}# 'private) - (if (not (equal? - #{mod\ 983}# - (module-name (current-module)))) - (#{modref-cont\ 974}# - #{mod\ 983}# - #{var\ 973}# - #f) - (#{bare-cont\ 975}# #{var\ 973}#)) - (if (eqv? #{kind\ 982}# 'bare) - (#{bare-cont\ 975}# #{var\ 973}#) - (if (eqv? #{kind\ 982}# 'hygiene) - (if (if (not (equal? - #{mod\ 983}# - (module-name (current-module)))) - (module-variable - (resolve-module #{mod\ 983}#) - #{var\ 973}#) - #f) - (#{modref-cont\ 974}# - #{mod\ 983}# - #{var\ 973}# - #f) - (#{bare-cont\ 975}# #{var\ 973}#)) - (syntax-violation - #f - "bad module kind" - #{var\ 973}# - #{mod\ 983}#)))))))))) - (#{build-global-reference\ 318}# - (lambda (#{source\ 991}# #{var\ 992}# #{mod\ 993}#) - (#{analyze-variable\ 316}# - #{mod\ 993}# - #{var\ 992}# - (lambda (#{mod\ 997}# #{var\ 998}# #{public?\ 999}#) - (#{make-module-ref\ 250}# - #{source\ 991}# - #{mod\ 997}# - #{var\ 998}# - #{public?\ 999}#)) - (lambda (#{var\ 1003}#) - (#{make-toplevel-ref\ 254}# - #{source\ 991}# - #{var\ 1003}#))))) - (#{build-global-assignment\ 320}# - (lambda (#{source\ 1005}# - #{var\ 1006}# - #{exp\ 1007}# - #{mod\ 1008}#) - (begin - (#{maybe-name-value!\ 302}# - #{var\ 1006}# - #{exp\ 1007}#) - (#{analyze-variable\ 316}# - #{mod\ 1008}# - #{var\ 1006}# - (lambda (#{mod\ 1013}# #{var\ 1014}# #{public?\ 1015}#) - (#{make-module-set\ 252}# - #{source\ 1005}# - #{mod\ 1013}# - #{var\ 1014}# - #{public?\ 1015}# - #{exp\ 1007}#)) - (lambda (#{var\ 1019}#) - (#{make-toplevel-set\ 256}# - #{source\ 1005}# - #{var\ 1019}# - #{exp\ 1007}#)))))) - (#{build-global-definition\ 322}# - (lambda (#{source\ 1021}# #{var\ 1022}# #{exp\ 1023}#) - (begin - (#{maybe-name-value!\ 302}# - #{var\ 1022}# - #{exp\ 1023}#) - (#{make-toplevel-define\ 258}# - #{source\ 1021}# - #{var\ 1022}# - #{exp\ 1023}#)))) - (#{build-simple-lambda\ 324}# - (lambda (#{src\ 1027}# - #{req\ 1028}# - #{rest\ 1029}# - #{vars\ 1030}# - #{meta\ 1031}# - #{exp\ 1032}#) - (#{make-lambda\ 266}# - #{src\ 1027}# - #{meta\ 1031}# - (#{make-lambda-case\ 268}# - #{src\ 1027}# - #{req\ 1028}# - #f - #{rest\ 1029}# - #f - '() - #{vars\ 1030}# - #{exp\ 1032}# - #f)))) - (#{build-case-lambda\ 326}# - (lambda (#{src\ 1039}# #{meta\ 1040}# #{body\ 1041}#) - (#{make-lambda\ 266}# - #{src\ 1039}# - #{meta\ 1040}# - #{body\ 1041}#))) - (#{build-lambda-case\ 328}# - (lambda (#{src\ 1045}# - #{req\ 1046}# - #{opt\ 1047}# - #{rest\ 1048}# - #{kw\ 1049}# - #{inits\ 1050}# - #{vars\ 1051}# - #{body\ 1052}# - #{else-case\ 1053}#) - (#{make-lambda-case\ 268}# - #{src\ 1045}# - #{req\ 1046}# - #{opt\ 1047}# - #{rest\ 1048}# - #{kw\ 1049}# - #{inits\ 1050}# - #{vars\ 1051}# - #{body\ 1052}# - #{else-case\ 1053}#))) - (#{build-primref\ 330}# - (lambda (#{src\ 1063}# #{name\ 1064}#) - (if (equal? (module-name (current-module)) '(guile)) - (#{make-toplevel-ref\ 254}# - #{src\ 1063}# - #{name\ 1064}#) + (#{modref-cont\ 1022}# + #{mod\ 1031}# + #{var\ 1021}# + #f) + (#{bare-cont\ 1023}# #{var\ 1021}#)) + (syntax-violation + #f + "bad module kind" + #{var\ 1021}# + #{mod\ 1031}#)))))))))) + (#{build-global-reference\ 314}# + (lambda (#{source\ 1039}# #{var\ 1040}# #{mod\ 1041}#) + (#{analyze-variable\ 312}# + #{mod\ 1041}# + #{var\ 1040}# + (lambda (#{mod\ 1045}# #{var\ 1046}# #{public?\ 1047}#) (#{make-module-ref\ 250}# - #{src\ 1063}# - '(guile) - #{name\ 1064}# - #f)))) - (#{build-data\ 332}# - (lambda (#{src\ 1067}# #{exp\ 1068}#) - (#{make-const\ 242}# #{src\ 1067}# #{exp\ 1068}#))) - (#{build-sequence\ 334}# - (lambda (#{src\ 1071}# #{exps\ 1072}#) - (if (null? (cdr #{exps\ 1072}#)) - (car #{exps\ 1072}#) - (#{make-sequence\ 264}# - #{src\ 1071}# - #{exps\ 1072}#)))) - (#{build-let\ 336}# - (lambda (#{src\ 1075}# - #{ids\ 1076}# - #{vars\ 1077}# - #{val-exps\ 1078}# - #{body-exp\ 1079}#) + #{source\ 1039}# + #{mod\ 1045}# + #{var\ 1046}# + #{public?\ 1047}#)) + (lambda (#{var\ 1051}#) + (#{make-toplevel-ref\ 254}# + #{source\ 1039}# + #{var\ 1051}#))))) + (#{build-global-assignment\ 316}# + (lambda (#{source\ 1053}# + #{var\ 1054}# + #{exp\ 1055}# + #{mod\ 1056}#) + (begin + (#{maybe-name-value!\ 298}# + #{var\ 1054}# + #{exp\ 1055}#) + (#{analyze-variable\ 312}# + #{mod\ 1056}# + #{var\ 1054}# + (lambda (#{mod\ 1061}# #{var\ 1062}# #{public?\ 1063}#) + (#{make-module-set\ 252}# + #{source\ 1053}# + #{mod\ 1061}# + #{var\ 1062}# + #{public?\ 1063}# + #{exp\ 1055}#)) + (lambda (#{var\ 1067}#) + (#{make-toplevel-set\ 256}# + #{source\ 1053}# + #{var\ 1067}# + #{exp\ 1055}#)))))) + (#{build-global-definition\ 318}# + (lambda (#{source\ 1069}# #{var\ 1070}# #{exp\ 1071}#) + (begin + (#{maybe-name-value!\ 298}# + #{var\ 1070}# + #{exp\ 1071}#) + (#{make-toplevel-define\ 258}# + #{source\ 1069}# + #{var\ 1070}# + #{exp\ 1071}#)))) + (#{build-simple-lambda\ 320}# + (lambda (#{src\ 1075}# + #{req\ 1076}# + #{rest\ 1077}# + #{vars\ 1078}# + #{meta\ 1079}# + #{exp\ 1080}#) + (#{make-lambda\ 266}# + #{src\ 1075}# + #{meta\ 1079}# + (#{make-lambda-case\ 268}# + #{src\ 1075}# + #{req\ 1076}# + #f + #{rest\ 1077}# + #f + '() + #{vars\ 1078}# + #{exp\ 1080}# + #f)))) + (#{build-case-lambda\ 322}# + (lambda (#{src\ 1087}# #{meta\ 1088}# #{body\ 1089}#) + (#{make-lambda\ 266}# + #{src\ 1087}# + #{meta\ 1088}# + #{body\ 1089}#))) + (#{build-lambda-case\ 324}# + (lambda (#{src\ 1093}# + #{req\ 1094}# + #{opt\ 1095}# + #{rest\ 1096}# + #{kw\ 1097}# + #{inits\ 1098}# + #{vars\ 1099}# + #{body\ 1100}# + #{else-case\ 1101}#) + (#{make-lambda-case\ 268}# + #{src\ 1093}# + #{req\ 1094}# + #{opt\ 1095}# + #{rest\ 1096}# + #{kw\ 1097}# + #{inits\ 1098}# + #{vars\ 1099}# + #{body\ 1100}# + #{else-case\ 1101}#))) + (#{build-primref\ 326}# + (lambda (#{src\ 1111}# #{name\ 1112}#) + (if (equal? (module-name (current-module)) '(guile)) + (#{make-toplevel-ref\ 254}# + #{src\ 1111}# + #{name\ 1112}#) + (#{make-module-ref\ 250}# + #{src\ 1111}# + '(guile) + #{name\ 1112}# + #f)))) + (#{build-data\ 328}# + (lambda (#{src\ 1115}# #{exp\ 1116}#) + (#{make-const\ 242}# #{src\ 1115}# #{exp\ 1116}#))) + (#{build-sequence\ 330}# + (lambda (#{src\ 1119}# #{exps\ 1120}#) + (if (null? (cdr #{exps\ 1120}#)) + (car #{exps\ 1120}#) + (#{make-sequence\ 264}# + #{src\ 1119}# + #{exps\ 1120}#)))) + (#{build-let\ 332}# + (lambda (#{src\ 1123}# + #{ids\ 1124}# + #{vars\ 1125}# + #{val-exps\ 1126}# + #{body-exp\ 1127}#) + (begin + (for-each + #{maybe-name-value!\ 298}# + #{ids\ 1124}# + #{val-exps\ 1126}#) + (if (null? #{vars\ 1125}#) + #{body-exp\ 1127}# + (#{make-let\ 270}# + #{src\ 1123}# + #{ids\ 1124}# + #{vars\ 1125}# + #{val-exps\ 1126}# + #{body-exp\ 1127}#))))) + (#{build-named-let\ 334}# + (lambda (#{src\ 1133}# + #{ids\ 1134}# + #{vars\ 1135}# + #{val-exps\ 1136}# + #{body-exp\ 1137}#) + (begin + (let ((#{f\ 1147}# (car #{vars\ 1135}#)) + (#{f-name\ 1148}# (car #{ids\ 1134}#)) + (#{vars\ 1149}# (cdr #{vars\ 1135}#)) + (#{ids\ 1150}# (cdr #{ids\ 1134}#))) + (begin + (let ((#{proc\ 1152}# + (#{build-simple-lambda\ 320}# + #{src\ 1133}# + #{ids\ 1150}# + #f + #{vars\ 1149}# + '() + #{body-exp\ 1137}#))) + (begin + (#{maybe-name-value!\ 298}# + #{f-name\ 1148}# + #{proc\ 1152}#) + (for-each + #{maybe-name-value!\ 298}# + #{ids\ 1150}# + #{val-exps\ 1136}#) + (#{make-letrec\ 272}# + #{src\ 1133}# + #f + (list #{f-name\ 1148}#) + (list #{f\ 1147}#) + (list #{proc\ 1152}#) + (#{build-application\ 302}# + #{src\ 1133}# + (#{build-lexical-reference\ 308}# + 'fun + #{src\ 1133}# + #{f-name\ 1148}# + #{f\ 1147}#) + #{val-exps\ 1136}#))))))))) + (#{build-letrec\ 336}# + (lambda (#{src\ 1153}# + #{in-order?\ 1154}# + #{ids\ 1155}# + #{vars\ 1156}# + #{val-exps\ 1157}# + #{body-exp\ 1158}#) + (if (null? #{vars\ 1156}#) + #{body-exp\ 1158}# (begin (for-each - #{maybe-name-value!\ 302}# - #{ids\ 1076}# - #{val-exps\ 1078}#) - (if (null? #{vars\ 1077}#) - #{body-exp\ 1079}# - (#{make-let\ 270}# - #{src\ 1075}# - #{ids\ 1076}# - #{vars\ 1077}# - #{val-exps\ 1078}# - #{body-exp\ 1079}#))))) - (#{build-named-let\ 338}# - (lambda (#{src\ 1085}# - #{ids\ 1086}# - #{vars\ 1087}# - #{val-exps\ 1088}# - #{body-exp\ 1089}#) - (begin - (let ((#{f\ 1099}# (car #{vars\ 1087}#)) - (#{f-name\ 1100}# (car #{ids\ 1086}#)) - (#{vars\ 1101}# (cdr #{vars\ 1087}#)) - (#{ids\ 1102}# (cdr #{ids\ 1086}#))) - (begin - (let ((#{proc\ 1104}# - (#{build-simple-lambda\ 324}# - #{src\ 1085}# - #{ids\ 1102}# - #f - #{vars\ 1101}# - '() - #{body-exp\ 1089}#))) - (begin - (#{maybe-name-value!\ 302}# - #{f-name\ 1100}# - #{proc\ 1104}#) - (for-each - #{maybe-name-value!\ 302}# - #{ids\ 1102}# - #{val-exps\ 1088}#) - (#{make-letrec\ 272}# - #{src\ 1085}# - #f - (list #{f-name\ 1100}#) - (list #{f\ 1099}#) - (list #{proc\ 1104}#) - (#{build-application\ 306}# - #{src\ 1085}# - (#{build-lexical-reference\ 312}# - 'fun - #{src\ 1085}# - #{f-name\ 1100}# - #{f\ 1099}#) - #{val-exps\ 1088}#))))))))) - (#{build-letrec\ 340}# - (lambda (#{src\ 1105}# - #{in-order?\ 1106}# - #{ids\ 1107}# - #{vars\ 1108}# - #{val-exps\ 1109}# - #{body-exp\ 1110}#) - (if (null? #{vars\ 1108}#) - #{body-exp\ 1110}# + #{maybe-name-value!\ 298}# + #{ids\ 1155}# + #{val-exps\ 1157}#) + (#{make-letrec\ 272}# + #{src\ 1153}# + #{in-order?\ 1154}# + #{ids\ 1155}# + #{vars\ 1156}# + #{val-exps\ 1157}# + #{body-exp\ 1158}#))))) + (#{make-syntax-object\ 340}# + (lambda (#{expression\ 1165}# + #{wrap\ 1166}# + #{module\ 1167}#) + (vector + 'syntax-object + #{expression\ 1165}# + #{wrap\ 1166}# + #{module\ 1167}#))) + (#{syntax-object?\ 342}# + (lambda (#{x\ 1171}#) + (if (vector? #{x\ 1171}#) + (if (= (vector-length #{x\ 1171}#) 4) + (eq? (vector-ref #{x\ 1171}# 0) 'syntax-object) + #f) + #f))) + (#{syntax-object-expression\ 344}# + (lambda (#{x\ 1176}#) (vector-ref #{x\ 1176}# 1))) + (#{syntax-object-wrap\ 346}# + (lambda (#{x\ 1178}#) (vector-ref #{x\ 1178}# 2))) + (#{syntax-object-module\ 348}# + (lambda (#{x\ 1180}#) (vector-ref #{x\ 1180}# 3))) + (#{source-annotation\ 357}# + (lambda (#{x\ 1194}#) + (if (#{syntax-object?\ 342}# #{x\ 1194}#) + (#{source-annotation\ 357}# + (#{syntax-object-expression\ 344}# #{x\ 1194}#)) + (if (pair? #{x\ 1194}#) (begin - (for-each - #{maybe-name-value!\ 302}# - #{ids\ 1107}# - #{val-exps\ 1109}#) - (#{make-letrec\ 272}# - #{src\ 1105}# - #{in-order?\ 1106}# - #{ids\ 1107}# - #{vars\ 1108}# - #{val-exps\ 1109}# - #{body-exp\ 1110}#))))) - (#{make-syntax-object\ 344}# - (lambda (#{expression\ 1117}# - #{wrap\ 1118}# - #{module\ 1119}#) - (vector - 'syntax-object - #{expression\ 1117}# - #{wrap\ 1118}# - #{module\ 1119}#))) - (#{syntax-object?\ 346}# - (lambda (#{x\ 1123}#) - (if (vector? #{x\ 1123}#) - (if (= (vector-length #{x\ 1123}#) 4) - (eq? (vector-ref #{x\ 1123}# 0) 'syntax-object) - #f) - #f))) - (#{syntax-object-expression\ 348}# - (lambda (#{x\ 1128}#) (vector-ref #{x\ 1128}# 1))) - (#{syntax-object-wrap\ 350}# - (lambda (#{x\ 1130}#) (vector-ref #{x\ 1130}# 2))) - (#{syntax-object-module\ 352}# - (lambda (#{x\ 1132}#) (vector-ref #{x\ 1132}# 3))) - (#{source-annotation\ 361}# - (lambda (#{x\ 1146}#) - (if (#{syntax-object?\ 346}# #{x\ 1146}#) - (#{source-annotation\ 361}# - (#{syntax-object-expression\ 348}# #{x\ 1146}#)) - (if (pair? #{x\ 1146}#) - (begin - (let ((#{props\ 1153}# (source-properties #{x\ 1146}#))) - (if (pair? #{props\ 1153}#) #{props\ 1153}# #f))) - #f)))) - (#{extend-env\ 368}# - (lambda (#{labels\ 1155}# #{bindings\ 1156}# #{r\ 1157}#) - (if (null? #{labels\ 1155}#) - #{r\ 1157}# - (#{extend-env\ 368}# - (cdr #{labels\ 1155}#) - (cdr #{bindings\ 1156}#) - (cons (cons (car #{labels\ 1155}#) - (car #{bindings\ 1156}#)) - #{r\ 1157}#))))) - (#{extend-var-env\ 370}# - (lambda (#{labels\ 1161}# #{vars\ 1162}# #{r\ 1163}#) - (if (null? #{labels\ 1161}#) - #{r\ 1163}# - (#{extend-var-env\ 370}# - (cdr #{labels\ 1161}#) - (cdr #{vars\ 1162}#) - (cons (cons (car #{labels\ 1161}#) - (cons 'lexical (car #{vars\ 1162}#))) - #{r\ 1163}#))))) - (#{macros-only-env\ 372}# - (lambda (#{r\ 1168}#) - (if (null? #{r\ 1168}#) - '() - (begin - (let ((#{a\ 1171}# (car #{r\ 1168}#))) - (if (eq? (car (cdr #{a\ 1171}#)) 'macro) - (cons #{a\ 1171}# - (#{macros-only-env\ 372}# (cdr #{r\ 1168}#))) - (#{macros-only-env\ 372}# (cdr #{r\ 1168}#)))))))) - (#{lookup\ 374}# - (lambda (#{x\ 1172}# #{r\ 1173}# #{mod\ 1174}#) + (let ((#{props\ 1201}# (source-properties #{x\ 1194}#))) + (if (pair? #{props\ 1201}#) #{props\ 1201}# #f))) + #f)))) + (#{extend-env\ 364}# + (lambda (#{labels\ 1203}# #{bindings\ 1204}# #{r\ 1205}#) + (if (null? #{labels\ 1203}#) + #{r\ 1205}# + (#{extend-env\ 364}# + (cdr #{labels\ 1203}#) + (cdr #{bindings\ 1204}#) + (cons (cons (car #{labels\ 1203}#) + (car #{bindings\ 1204}#)) + #{r\ 1205}#))))) + (#{extend-var-env\ 366}# + (lambda (#{labels\ 1209}# #{vars\ 1210}# #{r\ 1211}#) + (if (null? #{labels\ 1209}#) + #{r\ 1211}# + (#{extend-var-env\ 366}# + (cdr #{labels\ 1209}#) + (cdr #{vars\ 1210}#) + (cons (cons (car #{labels\ 1209}#) + (cons 'lexical (car #{vars\ 1210}#))) + #{r\ 1211}#))))) + (#{macros-only-env\ 368}# + (lambda (#{r\ 1216}#) + (if (null? #{r\ 1216}#) + '() (begin - (let ((#{t\ 1180}# (assq #{x\ 1172}# #{r\ 1173}#))) - (if #{t\ 1180}# - (cdr #{t\ 1180}#) - (if (symbol? #{x\ 1172}#) - (begin - (let ((#{t\ 1186}# - (#{get-global-definition-hook\ 298}# - #{x\ 1172}# - #{mod\ 1174}#))) - (if #{t\ 1186}# #{t\ 1186}# '(global)))) - '(displaced-lexical))))))) - (#{global-extend\ 376}# - (lambda (#{type\ 1191}# #{sym\ 1192}# #{val\ 1193}#) - (#{put-global-definition-hook\ 296}# - #{sym\ 1192}# - #{type\ 1191}# - #{val\ 1193}#))) - (#{nonsymbol-id?\ 378}# - (lambda (#{x\ 1197}#) - (if (#{syntax-object?\ 346}# #{x\ 1197}#) + (let ((#{a\ 1219}# (car #{r\ 1216}#))) + (if (eq? (car (cdr #{a\ 1219}#)) 'macro) + (cons #{a\ 1219}# + (#{macros-only-env\ 368}# (cdr #{r\ 1216}#))) + (#{macros-only-env\ 368}# (cdr #{r\ 1216}#)))))))) + (#{lookup\ 370}# + (lambda (#{x\ 1220}# #{r\ 1221}# #{mod\ 1222}#) + (begin + (let ((#{t\ 1228}# (assq #{x\ 1220}# #{r\ 1221}#))) + (if #{t\ 1228}# + (cdr #{t\ 1228}#) + (if (symbol? #{x\ 1220}#) + (begin + (let ((#{t\ 1234}# + (#{get-global-definition-hook\ 294}# + #{x\ 1220}# + #{mod\ 1222}#))) + (if #{t\ 1234}# #{t\ 1234}# '(global)))) + '(displaced-lexical))))))) + (#{global-extend\ 372}# + (lambda (#{type\ 1239}# #{sym\ 1240}# #{val\ 1241}#) + (#{put-global-definition-hook\ 292}# + #{sym\ 1240}# + #{type\ 1239}# + #{val\ 1241}#))) + (#{nonsymbol-id?\ 374}# + (lambda (#{x\ 1245}#) + (if (#{syntax-object?\ 342}# #{x\ 1245}#) + (symbol? + (#{syntax-object-expression\ 344}# #{x\ 1245}#)) + #f))) + (#{id?\ 376}# + (lambda (#{x\ 1249}#) + (if (symbol? #{x\ 1249}#) + #t + (if (#{syntax-object?\ 342}# #{x\ 1249}#) (symbol? - (#{syntax-object-expression\ 348}# #{x\ 1197}#)) - #f))) - (#{id?\ 380}# - (lambda (#{x\ 1201}#) - (if (symbol? #{x\ 1201}#) - #t - (if (#{syntax-object?\ 346}# #{x\ 1201}#) - (symbol? - (#{syntax-object-expression\ 348}# #{x\ 1201}#)) - #f)))) - (#{id-sym-name&marks\ 383}# - (lambda (#{x\ 1208}# #{w\ 1209}#) - (if (#{syntax-object?\ 346}# #{x\ 1208}#) - (values - (#{syntax-object-expression\ 348}# #{x\ 1208}#) - (#{join-marks\ 430}# - (car #{w\ 1209}#) - (car (#{syntax-object-wrap\ 350}# #{x\ 1208}#)))) - (values #{x\ 1208}# (car #{w\ 1209}#))))) - (#{gen-label\ 393}# - (lambda () (symbol->string (gensym "i")))) - (#{gen-labels\ 395}# - (lambda (#{ls\ 1215}#) - (if (null? #{ls\ 1215}#) - '() - (cons (#{gen-label\ 393}#) - (#{gen-labels\ 395}# (cdr #{ls\ 1215}#)))))) - (#{make-ribcage\ 398}# - (lambda (#{symnames\ 1217}# - #{marks\ 1218}# - #{labels\ 1219}#) - (vector - 'ribcage - #{symnames\ 1217}# - #{marks\ 1218}# - #{labels\ 1219}#))) - (#{ribcage-symnames\ 402}# - (lambda (#{x\ 1228}#) (vector-ref #{x\ 1228}# 1))) - (#{ribcage-marks\ 404}# - (lambda (#{x\ 1230}#) (vector-ref #{x\ 1230}# 2))) - (#{ribcage-labels\ 406}# - (lambda (#{x\ 1232}#) (vector-ref #{x\ 1232}# 3))) - (#{set-ribcage-symnames!\ 408}# - (lambda (#{x\ 1234}# #{update\ 1235}#) - (vector-set! #{x\ 1234}# 1 #{update\ 1235}#))) - (#{set-ribcage-marks!\ 410}# - (lambda (#{x\ 1238}# #{update\ 1239}#) - (vector-set! #{x\ 1238}# 2 #{update\ 1239}#))) - (#{set-ribcage-labels!\ 412}# - (lambda (#{x\ 1242}# #{update\ 1243}#) - (vector-set! #{x\ 1242}# 3 #{update\ 1243}#))) - (#{anti-mark\ 418}# - (lambda (#{w\ 1246}#) - (cons (cons #f (car #{w\ 1246}#)) - (cons 'shift (cdr #{w\ 1246}#))))) - (#{extend-ribcage!\ 422}# - (lambda (#{ribcage\ 1252}# #{id\ 1253}# #{label\ 1254}#) - (begin - (#{set-ribcage-symnames!\ 408}# - #{ribcage\ 1252}# - (cons (#{syntax-object-expression\ 348}# #{id\ 1253}#) - (#{ribcage-symnames\ 402}# #{ribcage\ 1252}#))) - (#{set-ribcage-marks!\ 410}# - #{ribcage\ 1252}# - (cons (car (#{syntax-object-wrap\ 350}# #{id\ 1253}#)) - (#{ribcage-marks\ 404}# #{ribcage\ 1252}#))) - (#{set-ribcage-labels!\ 412}# - #{ribcage\ 1252}# - (cons #{label\ 1254}# - (#{ribcage-labels\ 406}# #{ribcage\ 1252}#)))))) - (#{make-binding-wrap\ 424}# - (lambda (#{ids\ 1259}# #{labels\ 1260}# #{w\ 1261}#) - (if (null? #{ids\ 1259}#) - #{w\ 1261}# - (cons (car #{w\ 1261}#) - (cons (begin - (let ((#{labelvec\ 1268}# - (list->vector #{labels\ 1260}#))) - (begin - (let ((#{n\ 1270}# - (vector-length #{labelvec\ 1268}#))) - (begin - (let ((#{symnamevec\ 1273}# - (make-vector #{n\ 1270}#)) - (#{marksvec\ 1274}# - (make-vector #{n\ 1270}#))) - (begin - (letrec* - ((#{f\ 1278}# - (lambda (#{ids\ 1279}# - #{i\ 1280}#) - (if (not (null? #{ids\ 1279}#)) - (call-with-values - (lambda () - (#{id-sym-name&marks\ 383}# - (car #{ids\ 1279}#) - #{w\ 1261}#)) - (lambda (#{symname\ 1281}# - #{marks\ 1282}#) - (begin - (vector-set! - #{symnamevec\ 1273}# - #{i\ 1280}# - #{symname\ 1281}#) - (vector-set! - #{marksvec\ 1274}# - #{i\ 1280}# - #{marks\ 1282}#) - (#{f\ 1278}# - (cdr #{ids\ 1279}#) - (#{fx+\ 283}# - #{i\ 1280}# - 1))))))))) - (begin - (#{f\ 1278}# #{ids\ 1259}# 0))) - (#{make-ribcage\ 398}# - #{symnamevec\ 1273}# - #{marksvec\ 1274}# - #{labelvec\ 1268}#)))))))) - (cdr #{w\ 1261}#)))))) - (#{smart-append\ 426}# - (lambda (#{m1\ 1286}# #{m2\ 1287}#) - (if (null? #{m2\ 1287}#) - #{m1\ 1286}# - (append #{m1\ 1286}# #{m2\ 1287}#)))) - (#{join-wraps\ 428}# - (lambda (#{w1\ 1290}# #{w2\ 1291}#) - (begin - (let ((#{m1\ 1296}# (car #{w1\ 1290}#)) - (#{s1\ 1297}# (cdr #{w1\ 1290}#))) - (if (null? #{m1\ 1296}#) - (if (null? #{s1\ 1297}#) - #{w2\ 1291}# - (cons (car #{w2\ 1291}#) - (#{smart-append\ 426}# - #{s1\ 1297}# - (cdr #{w2\ 1291}#)))) - (cons (#{smart-append\ 426}# - #{m1\ 1296}# - (car #{w2\ 1291}#)) - (#{smart-append\ 426}# - #{s1\ 1297}# - (cdr #{w2\ 1291}#)))))))) - (#{join-marks\ 430}# - (lambda (#{m1\ 1306}# #{m2\ 1307}#) - (#{smart-append\ 426}# #{m1\ 1306}# #{m2\ 1307}#))) - (#{same-marks?\ 432}# - (lambda (#{x\ 1310}# #{y\ 1311}#) - (begin - (let ((#{t\ 1316}# (eq? #{x\ 1310}# #{y\ 1311}#))) - (if #{t\ 1316}# - #{t\ 1316}# - (if (not (null? #{x\ 1310}#)) - (if (not (null? #{y\ 1311}#)) - (if (eq? (car #{x\ 1310}#) (car #{y\ 1311}#)) - (#{same-marks?\ 432}# - (cdr #{x\ 1310}#) - (cdr #{y\ 1311}#)) - #f) - #f) - #f)))))) - (#{id-var-name\ 434}# - (lambda (#{id\ 1322}# #{w\ 1323}#) - (letrec* - ((#{search\ 1328}# - (lambda (#{sym\ 1344}# #{subst\ 1345}# #{marks\ 1346}#) - (if (null? #{subst\ 1345}#) - (values #f #{marks\ 1346}#) - (begin - (let ((#{fst\ 1351}# (car #{subst\ 1345}#))) - (if (eq? #{fst\ 1351}# 'shift) - (#{search\ 1328}# - #{sym\ 1344}# - (cdr #{subst\ 1345}#) - (cdr #{marks\ 1346}#)) - (begin - (let ((#{symnames\ 1353}# - (#{ribcage-symnames\ 402}# - #{fst\ 1351}#))) - (if (vector? #{symnames\ 1353}#) - (#{search-vector-rib\ 1332}# - #{sym\ 1344}# - #{subst\ 1345}# - #{marks\ 1346}# - #{symnames\ 1353}# - #{fst\ 1351}#) - (#{search-list-rib\ 1330}# - #{sym\ 1344}# - #{subst\ 1345}# - #{marks\ 1346}# - #{symnames\ 1353}# - #{fst\ 1351}#)))))))))) - (#{search-list-rib\ 1330}# - (lambda (#{sym\ 1354}# - #{subst\ 1355}# - #{marks\ 1356}# - #{symnames\ 1357}# - #{ribcage\ 1358}#) - (letrec* - ((#{f\ 1367}# - (lambda (#{symnames\ 1368}# #{i\ 1369}#) - (if (null? #{symnames\ 1368}#) - (#{search\ 1328}# - #{sym\ 1354}# - (cdr #{subst\ 1355}#) - #{marks\ 1356}#) - (if (if (eq? (car #{symnames\ 1368}#) - #{sym\ 1354}#) - (#{same-marks?\ 432}# - #{marks\ 1356}# - (list-ref - (#{ribcage-marks\ 404}# - #{ribcage\ 1358}#) - #{i\ 1369}#)) - #f) - (values - (list-ref - (#{ribcage-labels\ 406}# #{ribcage\ 1358}#) - #{i\ 1369}#) - #{marks\ 1356}#) - (#{f\ 1367}# - (cdr #{symnames\ 1368}#) - (#{fx+\ 283}# #{i\ 1369}# 1))))))) - (begin (#{f\ 1367}# #{symnames\ 1357}# 0))))) - (#{search-vector-rib\ 1332}# - (lambda (#{sym\ 1377}# - #{subst\ 1378}# - #{marks\ 1379}# - #{symnames\ 1380}# - #{ribcage\ 1381}#) - (begin - (let ((#{n\ 1388}# (vector-length #{symnames\ 1380}#))) - (letrec* - ((#{f\ 1391}# - (lambda (#{i\ 1392}#) - (if (#{fx=\ 287}# #{i\ 1392}# #{n\ 1388}#) - (#{search\ 1328}# - #{sym\ 1377}# - (cdr #{subst\ 1378}#) - #{marks\ 1379}#) - (if (if (eq? (vector-ref - #{symnames\ 1380}# - #{i\ 1392}#) - #{sym\ 1377}#) - (#{same-marks?\ 432}# - #{marks\ 1379}# - (vector-ref - (#{ribcage-marks\ 404}# - #{ribcage\ 1381}#) - #{i\ 1392}#)) - #f) - (values - (vector-ref - (#{ribcage-labels\ 406}# - #{ribcage\ 1381}#) - #{i\ 1392}#) - #{marks\ 1379}#) - (#{f\ 1391}# - (#{fx+\ 283}# #{i\ 1392}# 1))))))) - (begin (#{f\ 1391}# 0)))))))) - (begin - (if (symbol? #{id\ 1322}#) - (begin - (let ((#{t\ 1402}# - (call-with-values - (lambda () - (#{search\ 1328}# - #{id\ 1322}# - (cdr #{w\ 1323}#) - (car #{w\ 1323}#))) - (lambda (#{x\ 1406}# . #{ignore\ 1407}#) - #{x\ 1406}#)))) - (if #{t\ 1402}# #{t\ 1402}# #{id\ 1322}#))) - (if (#{syntax-object?\ 346}# #{id\ 1322}#) - (begin - (let ((#{id\ 1415}# - (#{syntax-object-expression\ 348}# - #{id\ 1322}#)) - (#{w1\ 1416}# - (#{syntax-object-wrap\ 350}# #{id\ 1322}#))) - (begin - (let ((#{marks\ 1418}# - (#{join-marks\ 430}# - (car #{w\ 1323}#) - (car #{w1\ 1416}#)))) - (call-with-values - (lambda () - (#{search\ 1328}# - #{id\ 1415}# - (cdr #{w\ 1323}#) - #{marks\ 1418}#)) - (lambda (#{new-id\ 1422}# #{marks\ 1423}#) - (begin - (let ((#{t\ 1428}# #{new-id\ 1422}#)) - (if #{t\ 1428}# - #{t\ 1428}# - (begin - (let ((#{t\ 1431}# - (call-with-values - (lambda () - (#{search\ 1328}# - #{id\ 1415}# - (cdr #{w1\ 1416}#) - #{marks\ 1423}#)) - (lambda (#{x\ 1434}# - . - #{ignore\ 1435}#) - #{x\ 1434}#)))) - (if #{t\ 1431}# - #{t\ 1431}# - #{id\ 1415}#)))))))))))) - (syntax-violation - 'id-var-name - "invalid id" - #{id\ 1322}#))))))) - (#{free-id=?\ 436}# - (lambda (#{i\ 1440}# #{j\ 1441}#) - (if (eq? (begin - (let ((#{x\ 1447}# #{i\ 1440}#)) - (if (#{syntax-object?\ 346}# #{x\ 1447}#) - (#{syntax-object-expression\ 348}# #{x\ 1447}#) - #{x\ 1447}#))) - (begin - (let ((#{x\ 1450}# #{j\ 1441}#)) - (if (#{syntax-object?\ 346}# #{x\ 1450}#) - (#{syntax-object-expression\ 348}# #{x\ 1450}#) - #{x\ 1450}#)))) - (eq? (#{id-var-name\ 434}# #{i\ 1440}# '(())) - (#{id-var-name\ 434}# #{j\ 1441}# '(()))) - #f))) - (#{bound-id=?\ 438}# - (lambda (#{i\ 1454}# #{j\ 1455}#) - (if (if (#{syntax-object?\ 346}# #{i\ 1454}#) - (#{syntax-object?\ 346}# #{j\ 1455}#) - #f) - (if (eq? (#{syntax-object-expression\ 348}# #{i\ 1454}#) - (#{syntax-object-expression\ 348}# #{j\ 1455}#)) - (#{same-marks?\ 432}# - (car (#{syntax-object-wrap\ 350}# #{i\ 1454}#)) - (car (#{syntax-object-wrap\ 350}# #{j\ 1455}#))) - #f) - (eq? #{i\ 1454}# #{j\ 1455}#)))) - (#{valid-bound-ids?\ 440}# - (lambda (#{ids\ 1464}#) - (if (letrec* - ((#{all-ids?\ 1469}# - (lambda (#{ids\ 1470}#) - (begin - (let ((#{t\ 1473}# (null? #{ids\ 1470}#))) - (if #{t\ 1473}# - #{t\ 1473}# - (if (#{id?\ 380}# (car #{ids\ 1470}#)) - (#{all-ids?\ 1469}# (cdr #{ids\ 1470}#)) - #f))))))) - (begin (#{all-ids?\ 1469}# #{ids\ 1464}#))) - (#{distinct-bound-ids?\ 442}# #{ids\ 1464}#) - #f))) - (#{distinct-bound-ids?\ 442}# - (lambda (#{ids\ 1478}#) - (letrec* - ((#{distinct?\ 1482}# - (lambda (#{ids\ 1483}#) - (begin - (let ((#{t\ 1486}# (null? #{ids\ 1483}#))) - (if #{t\ 1486}# - #{t\ 1486}# - (if (not (#{bound-id-member?\ 444}# - (car #{ids\ 1483}#) - (cdr #{ids\ 1483}#))) - (#{distinct?\ 1482}# (cdr #{ids\ 1483}#)) - #f))))))) - (begin (#{distinct?\ 1482}# #{ids\ 1478}#))))) - (#{bound-id-member?\ 444}# - (lambda (#{x\ 1490}# #{list\ 1491}#) - (if (not (null? #{list\ 1491}#)) - (begin - (let ((#{t\ 1498}# - (#{bound-id=?\ 438}# - #{x\ 1490}# - (car #{list\ 1491}#)))) - (if #{t\ 1498}# - #{t\ 1498}# - (#{bound-id-member?\ 444}# - #{x\ 1490}# - (cdr #{list\ 1491}#))))) - #f))) - (#{wrap\ 446}# - (lambda (#{x\ 1500}# #{w\ 1501}# #{defmod\ 1502}#) - (if (if (null? (car #{w\ 1501}#)) - (null? (cdr #{w\ 1501}#)) - #f) - #{x\ 1500}# - (if (#{syntax-object?\ 346}# #{x\ 1500}#) - (#{make-syntax-object\ 344}# - (#{syntax-object-expression\ 348}# #{x\ 1500}#) - (#{join-wraps\ 428}# - #{w\ 1501}# - (#{syntax-object-wrap\ 350}# #{x\ 1500}#)) - (#{syntax-object-module\ 352}# #{x\ 1500}#)) - (if (null? #{x\ 1500}#) - #{x\ 1500}# - (#{make-syntax-object\ 344}# - #{x\ 1500}# - #{w\ 1501}# - #{defmod\ 1502}#)))))) - (#{source-wrap\ 448}# - (lambda (#{x\ 1517}# - #{w\ 1518}# - #{s\ 1519}# - #{defmod\ 1520}#) - (#{wrap\ 446}# - (#{decorate-source\ 300}# - #{x\ 1517}# - #{s\ 1519}#) - #{w\ 1518}# - #{defmod\ 1520}#))) - (#{chi-sequence\ 450}# - (lambda (#{body\ 1525}# - #{r\ 1526}# - #{w\ 1527}# - #{s\ 1528}# - #{mod\ 1529}#) - (#{build-sequence\ 334}# - #{s\ 1528}# - (letrec* - ((#{dobody\ 1540}# - (lambda (#{body\ 1541}# - #{r\ 1542}# - #{w\ 1543}# - #{mod\ 1544}#) - (if (null? #{body\ 1541}#) - '() - (begin - (let ((#{first\ 1546}# - (#{chi\ 460}# - (car #{body\ 1541}#) - #{r\ 1542}# - #{w\ 1543}# - #{mod\ 1544}#))) - (cons #{first\ 1546}# - (#{dobody\ 1540}# - (cdr #{body\ 1541}#) - #{r\ 1542}# - #{w\ 1543}# - #{mod\ 1544}#)))))))) - (begin - (#{dobody\ 1540}# - #{body\ 1525}# - #{r\ 1526}# - #{w\ 1527}# - #{mod\ 1529}#)))))) - (#{chi-top-sequence\ 452}# - (lambda (#{body\ 1547}# - #{r\ 1548}# - #{w\ 1549}# - #{s\ 1550}# - #{m\ 1551}# - #{esew\ 1552}# - #{mod\ 1553}#) - (letrec* - ((#{scan\ 1562}# - (lambda (#{body\ 1563}# - #{r\ 1564}# - #{w\ 1565}# - #{s\ 1566}# - #{m\ 1567}# - #{esew\ 1568}# - #{mod\ 1569}# - #{exps\ 1570}#) - (if (null? #{body\ 1563}#) - #{exps\ 1570}# - (call-with-values - (lambda () - (call-with-values - (lambda () - (begin - (let ((#{e\ 1583}# (car #{body\ 1563}#))) - (#{syntax-type\ 458}# - #{e\ 1583}# - #{r\ 1564}# - #{w\ 1565}# - (begin - (let ((#{t\ 1586}# - (#{source-annotation\ 361}# - #{e\ 1583}#))) - (if #{t\ 1586}# - #{t\ 1586}# - #{s\ 1566}#))) - #f - #{mod\ 1569}# - #f)))) - (lambda (#{type\ 1588}# - #{value\ 1589}# - #{e\ 1590}# - #{w\ 1591}# - #{s\ 1592}# - #{mod\ 1593}#) - (if (eqv? #{type\ 1588}# 'begin-form) - (let ((#{tmp\ 1601}# #{e\ 1590}#)) - (let ((#{tmp\ 1602}# - ($sc-dispatch #{tmp\ 1601}# '(_)))) - (if #{tmp\ 1602}# - (@apply - (lambda () #{exps\ 1570}#) - #{tmp\ 1602}#) - (let ((#{tmp\ 1603}# - ($sc-dispatch - #{tmp\ 1601}# - '(_ any . each-any)))) - (if #{tmp\ 1603}# - (@apply - (lambda (#{e1\ 1606}# #{e2\ 1607}#) - (#{scan\ 1562}# - (cons #{e1\ 1606}# - #{e2\ 1607}#) - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - #{m\ 1567}# - #{esew\ 1568}# - #{mod\ 1593}# - #{exps\ 1570}#)) - #{tmp\ 1603}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1601}#)))))) - (if (eqv? #{type\ 1588}# 'local-syntax-form) - (#{chi-local-syntax\ 470}# - #{value\ 1589}# - #{e\ 1590}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - #{mod\ 1593}# - (lambda (#{body\ 1610}# - #{r\ 1611}# - #{w\ 1612}# - #{s\ 1613}# - #{mod\ 1614}#) - (#{scan\ 1562}# - #{body\ 1610}# - #{r\ 1611}# - #{w\ 1612}# - #{s\ 1613}# - #{m\ 1567}# - #{esew\ 1568}# - #{mod\ 1614}# - #{exps\ 1570}#))) - (if (eqv? #{type\ 1588}# 'eval-when-form) - (let ((#{tmp\ 1621}# #{e\ 1590}#)) - (let ((#{tmp\ 1622}# - ($sc-dispatch - #{tmp\ 1621}# - '(_ each-any any . each-any)))) - (if #{tmp\ 1622}# - (@apply - (lambda (#{x\ 1626}# - #{e1\ 1627}# - #{e2\ 1628}#) - (begin - (let ((#{when-list\ 1631}# - (#{chi-when-list\ 456}# - #{e\ 1590}# - #{x\ 1626}# - #{w\ 1591}#)) - (#{body\ 1632}# - (cons #{e1\ 1627}# - #{e2\ 1628}#))) - (if (eq? #{m\ 1567}# 'e) - (if (memq 'eval - #{when-list\ 1631}#) - (#{scan\ 1562}# - #{body\ 1632}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - (if (memq 'expand - #{when-list\ 1631}#) - 'c&e - 'e) - '(eval) - #{mod\ 1593}# - #{exps\ 1570}#) - (begin - (if (memq 'expand - #{when-list\ 1631}#) - (#{top-level-eval-hook\ 291}# - (#{chi-top-sequence\ 452}# - #{body\ 1632}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - 'e - '(eval) - #{mod\ 1593}#) - #{mod\ 1593}#)) - #{exps\ 1570}#)) - (if (memq 'load - #{when-list\ 1631}#) - (if (begin - (let ((#{t\ 1641}# - (memq 'compile - #{when-list\ 1631}#))) - (if #{t\ 1641}# - #{t\ 1641}# - (begin - (let ((#{t\ 1644}# - (memq 'expand - #{when-list\ 1631}#))) - (if #{t\ 1644}# - #{t\ 1644}# - (if (eq? #{m\ 1567}# - 'c&e) - (memq 'eval - #{when-list\ 1631}#) - #f))))))) - (#{scan\ 1562}# - #{body\ 1632}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - 'c&e - '(compile load) - #{mod\ 1593}# - #{exps\ 1570}#) - (if (if (eq? #{m\ 1567}# - 'c) - #t - (eq? #{m\ 1567}# - 'c&e)) - (#{scan\ 1562}# - #{body\ 1632}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - 'c - '(load) - #{mod\ 1593}# - #{exps\ 1570}#) - #{exps\ 1570}#)) - (if (begin - (let ((#{t\ 1652}# - (memq 'compile - #{when-list\ 1631}#))) - (if #{t\ 1652}# - #{t\ 1652}# - (begin - (let ((#{t\ 1655}# - (memq 'expand - #{when-list\ 1631}#))) - (if #{t\ 1655}# - #{t\ 1655}# - (if (eq? #{m\ 1567}# - 'c&e) - (memq 'eval - #{when-list\ 1631}#) - #f))))))) - (begin - (#{top-level-eval-hook\ 291}# - (#{chi-top-sequence\ 452}# - #{body\ 1632}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - 'e - '(eval) - #{mod\ 1593}#) - #{mod\ 1593}#) - #{exps\ 1570}#) - #{exps\ 1570}#)))))) - #{tmp\ 1622}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1621}#)))) - (if (eqv? #{type\ 1588}# - 'define-syntax-form) - (begin - (let ((#{n\ 1663}# - (#{id-var-name\ 434}# - #{value\ 1589}# - #{w\ 1591}#)) - (#{r\ 1664}# - (#{macros-only-env\ 372}# - #{r\ 1564}#))) - (if (eqv? #{m\ 1567}# 'c) - (if (memq 'compile #{esew\ 1568}#) - (begin - (let ((#{e\ 1667}# - (#{chi-install-global\ 454}# - #{n\ 1663}# - (#{chi\ 460}# - #{e\ 1590}# - #{r\ 1664}# - #{w\ 1591}# - #{mod\ 1593}#)))) - (begin - (#{top-level-eval-hook\ 291}# - #{e\ 1667}# - #{mod\ 1593}#) - (if (memq 'load - #{esew\ 1568}#) - (cons #{e\ 1667}# - #{exps\ 1570}#) - #{exps\ 1570}#)))) - (if (memq 'load #{esew\ 1568}#) - (cons (#{chi-install-global\ 454}# - #{n\ 1663}# - (#{chi\ 460}# - #{e\ 1590}# - #{r\ 1664}# - #{w\ 1591}# - #{mod\ 1593}#)) - #{exps\ 1570}#) - #{exps\ 1570}#)) - (if (eqv? #{m\ 1567}# 'c&e) - (begin - (let ((#{e\ 1670}# - (#{chi-install-global\ 454}# - #{n\ 1663}# - (#{chi\ 460}# - #{e\ 1590}# - #{r\ 1664}# - #{w\ 1591}# - #{mod\ 1593}#)))) - (begin - (#{top-level-eval-hook\ 291}# - #{e\ 1670}# - #{mod\ 1593}#) - (cons #{e\ 1670}# - #{exps\ 1570}#)))) - (begin - (if (memq 'eval #{esew\ 1568}#) - (#{top-level-eval-hook\ 291}# - (#{chi-install-global\ 454}# - #{n\ 1663}# - (#{chi\ 460}# - #{e\ 1590}# - #{r\ 1664}# - #{w\ 1591}# - #{mod\ 1593}#)) - #{mod\ 1593}#)) - #{exps\ 1570}#))))) - (if (eqv? #{type\ 1588}# 'define-form) - (begin - (let ((#{n\ 1675}# - (#{id-var-name\ 434}# - #{value\ 1589}# - #{w\ 1591}#))) - (begin - (let ((#{type\ 1677}# - (car (#{lookup\ 374}# - #{n\ 1675}# - #{r\ 1564}# - #{mod\ 1593}#)))) - (if (if (eqv? #{type\ 1677}# - 'global) - #t - (if (eqv? #{type\ 1677}# - 'core) - #t - (if (eqv? #{type\ 1677}# - 'macro) - #t - (eqv? #{type\ 1677}# - 'module-ref)))) - (begin - (if (if (if (eq? #{m\ 1567}# - 'c) - #t - (eq? #{m\ 1567}# - 'c&e)) - (if (not (module-local-variable - (current-module) - #{n\ 1675}#)) - (current-module) - #f) - #f) - (begin - (let ((#{old\ 1684}# - (module-variable - (current-module) - #{n\ 1675}#))) - (if (if (variable? - #{old\ 1684}#) - (variable-bound? - #{old\ 1684}#) - #f) - (module-define! - (current-module) - #{n\ 1675}# - (variable-ref - #{old\ 1684}#)) - (module-add! - (current-module) - #{n\ 1675}# - (make-undefined-variable)))))) - (cons (if (eq? #{m\ 1567}# - 'c&e) - (begin - (let ((#{x\ 1688}# - (#{build-global-definition\ 322}# - #{s\ 1592}# - #{n\ 1675}# - (#{chi\ 460}# - #{e\ 1590}# - #{r\ 1564}# - #{w\ 1591}# - #{mod\ 1593}#)))) - (begin - (#{top-level-eval-hook\ 291}# - #{x\ 1688}# - #{mod\ 1593}#) - #{x\ 1688}#))) - (lambda () - (#{build-global-definition\ 322}# - #{s\ 1592}# - #{n\ 1675}# - (#{chi\ 460}# - #{e\ 1590}# - #{r\ 1564}# - #{w\ 1591}# - #{mod\ 1593}#)))) - #{exps\ 1570}#)) - (if (eqv? #{type\ 1677}# - 'displaced-lexical) - (syntax-violation - #f - "identifier out of context" - #{e\ 1590}# - (#{wrap\ 446}# - #{value\ 1589}# - #{w\ 1591}# - #{mod\ 1593}#)) - (syntax-violation - #f - "cannot define keyword at top level" - #{e\ 1590}# - (#{wrap\ 446}# - #{value\ 1589}# - #{w\ 1591}# - #{mod\ 1593}#)))))))) - (cons (if (eq? #{m\ 1567}# 'c&e) - (begin - (let ((#{x\ 1693}# - (#{chi-expr\ 462}# - #{type\ 1588}# - #{value\ 1589}# - #{e\ 1590}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - #{mod\ 1593}#))) - (begin - (#{top-level-eval-hook\ 291}# - #{x\ 1693}# - #{mod\ 1593}#) - #{x\ 1693}#))) - (lambda () - (#{chi-expr\ 462}# - #{type\ 1588}# - #{value\ 1589}# - #{e\ 1590}# - #{r\ 1564}# - #{w\ 1591}# - #{s\ 1592}# - #{mod\ 1593}#))) - #{exps\ 1570}#))))))))) - (lambda (#{exps\ 1694}#) - (#{scan\ 1562}# - (cdr #{body\ 1563}#) - #{r\ 1564}# - #{w\ 1565}# - #{s\ 1566}# - #{m\ 1567}# - #{esew\ 1568}# - #{mod\ 1569}# - #{exps\ 1694}#))))))) - (begin - (call-with-values - (lambda () - (#{scan\ 1562}# - #{body\ 1547}# - #{r\ 1548}# - #{w\ 1549}# - #{s\ 1550}# - #{m\ 1551}# - #{esew\ 1552}# - #{mod\ 1553}# - '())) - (lambda (#{exps\ 1696}#) - (if (null? #{exps\ 1696}#) - (#{build-void\ 304}# #{s\ 1550}#) - (#{build-sequence\ 334}# - #{s\ 1550}# - (letrec* - ((#{lp\ 1701}# - (lambda (#{in\ 1702}# #{out\ 1703}#) - (if (null? #{in\ 1702}#) - #{out\ 1703}# - (begin - (let ((#{e\ 1705}# (car #{in\ 1702}#))) - (#{lp\ 1701}# - (cdr #{in\ 1702}#) - (cons (if (procedure? #{e\ 1705}#) - (#{e\ 1705}#) - #{e\ 1705}#) - #{out\ 1703}#)))))))) - (begin (#{lp\ 1701}# #{exps\ 1696}# '()))))))))))) - (#{chi-install-global\ 454}# - (lambda (#{name\ 1706}# #{e\ 1707}#) - (#{build-global-definition\ 322}# - #f - #{name\ 1706}# - (#{build-application\ 306}# - #f - (#{build-primref\ 330}# - #f - 'make-syntax-transformer) - (list (#{build-data\ 332}# #f #{name\ 1706}#) - (#{build-data\ 332}# #f 'macro) - #{e\ 1707}#))))) - (#{chi-when-list\ 456}# - (lambda (#{e\ 1715}# #{when-list\ 1716}# #{w\ 1717}#) - (letrec* - ((#{f\ 1724}# - (lambda (#{when-list\ 1725}# #{situations\ 1726}#) - (if (null? #{when-list\ 1725}#) - #{situations\ 1726}# - (#{f\ 1724}# - (cdr #{when-list\ 1725}#) - (cons (begin - (let ((#{x\ 1728}# (car #{when-list\ 1725}#))) - (if (#{free-id=?\ 436}# - #{x\ 1728}# - '#(syntax-object - compile - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i1727")) - #(ribcage () () ()) - #(ribcage - #(f when-list situations) - #((top) (top) (top)) - #("i1721" "i1722" "i1723")) - #(ribcage () () ()) - #(ribcage - #(e when-list w) - #((top) (top) (top)) - #("i1718" "i1719" "i1720")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile))) - 'compile - (if (#{free-id=?\ 436}# - #{x\ 1728}# - '#(syntax-object - load - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("i1727")) - #(ribcage () () ()) - #(ribcage - #(f when-list situations) - #((top) (top) (top)) - #("i1721" "i1722" "i1723")) - #(ribcage () () ()) - #(ribcage - #(e when-list w) - #((top) (top) (top)) - #("i1718" "i1719" "i1720")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile))) - 'load - (if (#{free-id=?\ 436}# - #{x\ 1728}# - '#(syntax-object - eval - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("i1727")) - #(ribcage () () ()) - #(ribcage - #(f when-list situations) - #((top) (top) (top)) - #("i1721" "i1722" "i1723")) - #(ribcage () () ()) - #(ribcage - #(e when-list w) - #((top) (top) (top)) - #("i1718" "i1719" "i1720")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile))) - 'eval - (if (#{free-id=?\ 436}# - #{x\ 1728}# - '#(syntax-object - expand - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("i1727")) - #(ribcage () () ()) - #(ribcage - #(f when-list situations) - #((top) (top) (top)) - #("i1721" "i1722" "i1723")) - #(ribcage () () ()) - #(ribcage - #(e when-list w) - #((top) (top) (top)) - #("i1718" "i1719" "i1720")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile))) - 'expand - (syntax-violation - 'eval-when - "invalid situation" - #{e\ 1715}# - (#{wrap\ 446}# - #{x\ 1728}# - #{w\ 1717}# - #f)))))))) - #{situations\ 1726}#)))))) - (begin (#{f\ 1724}# #{when-list\ 1716}# '()))))) - (#{syntax-type\ 458}# - (lambda (#{e\ 1738}# - #{r\ 1739}# - #{w\ 1740}# - #{s\ 1741}# - #{rib\ 1742}# - #{mod\ 1743}# - #{for-car?\ 1744}#) - (if (symbol? #{e\ 1738}#) - (begin - (let ((#{n\ 1756}# - (#{id-var-name\ 434}# #{e\ 1738}# #{w\ 1740}#))) - (begin - (let ((#{b\ 1758}# - (#{lookup\ 374}# - #{n\ 1756}# - #{r\ 1739}# - #{mod\ 1743}#))) - (begin - (let ((#{type\ 1760}# (car #{b\ 1758}#))) - (if (eqv? #{type\ 1760}# 'lexical) - (values - #{type\ 1760}# - (cdr #{b\ 1758}#) - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{type\ 1760}# 'global) - (values - #{type\ 1760}# - #{n\ 1756}# - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{type\ 1760}# 'macro) - (if #{for-car?\ 1744}# - (values - #{type\ 1760}# - (cdr #{b\ 1758}#) - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (#{syntax-type\ 458}# - (#{chi-macro\ 466}# - (cdr #{b\ 1758}#) - #{e\ 1738}# - #{r\ 1739}# - #{w\ 1740}# - #{s\ 1741}# - #{rib\ 1742}# - #{mod\ 1743}#) - #{r\ 1739}# - '(()) - #{s\ 1741}# - #{rib\ 1742}# - #{mod\ 1743}# - #f)) - (values - #{type\ 1760}# - (cdr #{b\ 1758}#) - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#)))))))))) - (if (pair? #{e\ 1738}#) - (begin - (let ((#{first\ 1774}# (car #{e\ 1738}#))) - (call-with-values - (lambda () - (#{syntax-type\ 458}# - #{first\ 1774}# - #{r\ 1739}# - #{w\ 1740}# - #{s\ 1741}# - #{rib\ 1742}# - #{mod\ 1743}# - #t)) - (lambda (#{ftype\ 1775}# - #{fval\ 1776}# - #{fe\ 1777}# - #{fw\ 1778}# - #{fs\ 1779}# - #{fmod\ 1780}#) - (if (eqv? #{ftype\ 1775}# 'lexical) - (values - 'lexical-call - #{fval\ 1776}# - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{ftype\ 1775}# 'global) - (values - 'global-call - (#{make-syntax-object\ 344}# - #{fval\ 1776}# - #{w\ 1740}# - #{fmod\ 1780}#) - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{ftype\ 1775}# 'macro) - (#{syntax-type\ 458}# - (#{chi-macro\ 466}# - #{fval\ 1776}# - #{e\ 1738}# - #{r\ 1739}# - #{w\ 1740}# - #{s\ 1741}# - #{rib\ 1742}# - #{mod\ 1743}#) - #{r\ 1739}# - '(()) - #{s\ 1741}# - #{rib\ 1742}# - #{mod\ 1743}# - #{for-car?\ 1744}#) - (if (eqv? #{ftype\ 1775}# 'module-ref) - (call-with-values - (lambda () - (#{fval\ 1776}# - #{e\ 1738}# - #{r\ 1739}# - #{w\ 1740}#)) - (lambda (#{e\ 1792}# - #{r\ 1793}# - #{w\ 1794}# - #{s\ 1795}# - #{mod\ 1796}#) - (#{syntax-type\ 458}# - #{e\ 1792}# - #{r\ 1793}# - #{w\ 1794}# - #{s\ 1795}# - #{rib\ 1742}# - #{mod\ 1796}# - #{for-car?\ 1744}#))) - (if (eqv? #{ftype\ 1775}# 'core) - (values - 'core-form - #{fval\ 1776}# - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{ftype\ 1775}# 'local-syntax) - (values - 'local-syntax-form - #{fval\ 1776}# - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{ftype\ 1775}# 'begin) - (values - 'begin-form - #f - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{ftype\ 1775}# 'eval-when) - (values - 'eval-when-form - #f - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (if (eqv? #{ftype\ 1775}# 'define) - (let ((#{tmp\ 1807}# #{e\ 1738}#)) - (let ((#{tmp\ 1808}# - ($sc-dispatch - #{tmp\ 1807}# - '(_ any any)))) - (if (if #{tmp\ 1808}# - (@apply - (lambda (#{name\ 1811}# - #{val\ 1812}#) - (#{id?\ 380}# - #{name\ 1811}#)) - #{tmp\ 1808}#) - #f) - (@apply - (lambda (#{name\ 1815}# - #{val\ 1816}#) - (values - 'define-form - #{name\ 1815}# - #{val\ 1816}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#)) - #{tmp\ 1808}#) - (let ((#{tmp\ 1817}# - ($sc-dispatch - #{tmp\ 1807}# - '(_ (any . any) - any - . - each-any)))) - (if (if #{tmp\ 1817}# - (@apply - (lambda (#{name\ 1822}# - #{args\ 1823}# - #{e1\ 1824}# - #{e2\ 1825}#) - (if (#{id?\ 380}# - #{name\ 1822}#) - (#{valid-bound-ids?\ 440}# - (#{lambda-var-list\ 490}# - #{args\ 1823}#)) - #f)) - #{tmp\ 1817}#) - #f) - (@apply - (lambda (#{name\ 1832}# - #{args\ 1833}# - #{e1\ 1834}# - #{e2\ 1835}#) - (values - 'define-form - (#{wrap\ 446}# - #{name\ 1832}# - #{w\ 1740}# - #{mod\ 1743}#) - (#{decorate-source\ 300}# - (cons '#(syntax-object - lambda - ((top) - #(ribcage - #(name - args - e1 - e2) - #((top) - (top) - (top) - (top)) - #("i1828" - "i1829" - "i1830" - "i1831")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(ftype - fval - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("i1781" - "i1782" - "i1783" - "i1784" - "i1785" - "i1786")) - #(ribcage - () - () - ()) - #(ribcage - #(first) - #((top)) - #("i1773")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("i1745" - "i1746" - "i1747" - "i1748" - "i1749" - "i1750" - "i1751")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) - (top) - (top) - (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene - guile)) - (#{wrap\ 446}# - (cons #{args\ 1833}# - (cons #{e1\ 1834}# - #{e2\ 1835}#)) - #{w\ 1740}# - #{mod\ 1743}#)) - #{s\ 1741}#) - '(()) - #{s\ 1741}# - #{mod\ 1743}#)) - #{tmp\ 1817}#) - (let ((#{tmp\ 1838}# - ($sc-dispatch - #{tmp\ 1807}# - '(_ any)))) - (if (if #{tmp\ 1838}# - (@apply - (lambda (#{name\ 1840}#) - (#{id?\ 380}# - #{name\ 1840}#)) - #{tmp\ 1838}#) - #f) - (@apply - (lambda (#{name\ 1842}#) - (values - 'define-form - (#{wrap\ 446}# - #{name\ 1842}# - #{w\ 1740}# - #{mod\ 1743}#) - '(#(syntax-object - if - ((top) - #(ribcage - #(name) - #((top)) - #("i1841")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(ftype - fval - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("i1781" - "i1782" - "i1783" - "i1784" - "i1785" - "i1786")) - #(ribcage - () - () - ()) - #(ribcage - #(first) - #((top)) - #("i1773")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("i1745" - "i1746" - "i1747" - "i1748" - "i1749" - "i1750" - "i1751")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) - (top) - (top) - (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene - guile)) - #(syntax-object - #f - ((top) - #(ribcage - #(name) - #((top)) - #("i1841")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(ftype - fval - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("i1781" - "i1782" - "i1783" - "i1784" - "i1785" - "i1786")) - #(ribcage - () - () - ()) - #(ribcage - #(first) - #((top)) - #("i1773")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("i1745" - "i1746" - "i1747" - "i1748" - "i1749" - "i1750" - "i1751")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) - (top) - (top) - (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene - guile)) - #(syntax-object - #f - ((top) - #(ribcage - #(name) - #((top)) - #("i1841")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(ftype - fval - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("i1781" - "i1782" - "i1783" - "i1784" - "i1785" - "i1786")) - #(ribcage - () - () - ()) - #(ribcage - #(first) - #((top)) - #("i1773")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("i1745" - "i1746" - "i1747" - "i1748" - "i1749" - "i1750" - "i1751")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) - (top) - (top) - (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene - guile))) - '(()) - #{s\ 1741}# - #{mod\ 1743}#)) - #{tmp\ 1838}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1807}#)))))))) - (if (eqv? #{ftype\ 1775}# - 'define-syntax) - (let ((#{tmp\ 1845}# #{e\ 1738}#)) - (let ((#{tmp\ 1846}# - ($sc-dispatch - #{tmp\ 1845}# - '(_ any any)))) - (if (if #{tmp\ 1846}# - (@apply - (lambda (#{name\ 1849}# - #{val\ 1850}#) - (#{id?\ 380}# - #{name\ 1849}#)) - #{tmp\ 1846}#) - #f) - (@apply - (lambda (#{name\ 1853}# - #{val\ 1854}#) - (values - 'define-syntax-form - #{name\ 1853}# - #{val\ 1854}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#)) - #{tmp\ 1846}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1845}#)))) - (values - 'call - #f - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#))))))))))))))) - (if (#{syntax-object?\ 346}# #{e\ 1738}#) - (#{syntax-type\ 458}# - (#{syntax-object-expression\ 348}# #{e\ 1738}#) - #{r\ 1739}# - (#{join-wraps\ 428}# - #{w\ 1740}# - (#{syntax-object-wrap\ 350}# #{e\ 1738}#)) - (begin - (let ((#{t\ 1860}# - (#{source-annotation\ 361}# #{e\ 1738}#))) - (if #{t\ 1860}# #{t\ 1860}# #{s\ 1741}#))) - #{rib\ 1742}# - (begin - (let ((#{t\ 1864}# - (#{syntax-object-module\ 352}# #{e\ 1738}#))) - (if #{t\ 1864}# #{t\ 1864}# #{mod\ 1743}#))) - #{for-car?\ 1744}#) - (if (self-evaluating? #{e\ 1738}#) - (values - 'constant - #f - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#) - (values - 'other - #f - #{e\ 1738}# - #{w\ 1740}# - #{s\ 1741}# - #{mod\ 1743}#))))))) - (#{chi\ 460}# - (lambda (#{e\ 1869}# - #{r\ 1870}# - #{w\ 1871}# - #{mod\ 1872}#) - (call-with-values - (lambda () - (#{syntax-type\ 458}# - #{e\ 1869}# - #{r\ 1870}# - #{w\ 1871}# - (#{source-annotation\ 361}# #{e\ 1869}#) - #f - #{mod\ 1872}# - #f)) - (lambda (#{type\ 1877}# - #{value\ 1878}# - #{e\ 1879}# - #{w\ 1880}# - #{s\ 1881}# - #{mod\ 1882}#) - (#{chi-expr\ 462}# - #{type\ 1877}# - #{value\ 1878}# - #{e\ 1879}# - #{r\ 1870}# - #{w\ 1880}# - #{s\ 1881}# - #{mod\ 1882}#))))) - (#{chi-expr\ 462}# - (lambda (#{type\ 1889}# - #{value\ 1890}# - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - (if (eqv? #{type\ 1889}# 'lexical) - (#{build-lexical-reference\ 312}# - 'value - #{s\ 1894}# - #{e\ 1891}# - #{value\ 1890}#) - (if (if (eqv? #{type\ 1889}# 'core) - #t - (eqv? #{type\ 1889}# 'core-form)) - (#{value\ 1890}# - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - (if (eqv? #{type\ 1889}# 'module-ref) - (call-with-values - (lambda () - (#{value\ 1890}# - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}#)) - (lambda (#{e\ 1906}# - #{r\ 1907}# - #{w\ 1908}# - #{s\ 1909}# - #{mod\ 1910}#) - (#{chi\ 460}# - #{e\ 1906}# - #{r\ 1907}# - #{w\ 1908}# - #{mod\ 1910}#))) - (if (eqv? #{type\ 1889}# 'lexical-call) - (#{chi-application\ 464}# - (begin - (let ((#{id\ 1918}# (car #{e\ 1891}#))) - (#{build-lexical-reference\ 312}# - 'fun - (#{source-annotation\ 361}# #{id\ 1918}#) - (if (#{syntax-object?\ 346}# #{id\ 1918}#) - (syntax->datum #{id\ 1918}#) - #{id\ 1918}#) - #{value\ 1890}#))) - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - (if (eqv? #{type\ 1889}# 'global-call) - (#{chi-application\ 464}# - (#{build-global-reference\ 318}# - (#{source-annotation\ 361}# (car #{e\ 1891}#)) - (if (#{syntax-object?\ 346}# #{value\ 1890}#) - (#{syntax-object-expression\ 348}# - #{value\ 1890}#) - #{value\ 1890}#) - (if (#{syntax-object?\ 346}# #{value\ 1890}#) - (#{syntax-object-module\ 352}# #{value\ 1890}#) - #{mod\ 1895}#)) - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - (if (eqv? #{type\ 1889}# 'constant) - (#{build-data\ 332}# - #{s\ 1894}# - (#{strip\ 486}# - (#{source-wrap\ 448}# - #{e\ 1891}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - '(()))) - (if (eqv? #{type\ 1889}# 'global) - (#{build-global-reference\ 318}# - #{s\ 1894}# - #{value\ 1890}# - #{mod\ 1895}#) - (if (eqv? #{type\ 1889}# 'call) - (#{chi-application\ 464}# - (#{chi\ 460}# - (car #{e\ 1891}#) - #{r\ 1892}# - #{w\ 1893}# - #{mod\ 1895}#) - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - (if (eqv? #{type\ 1889}# 'begin-form) - (let ((#{tmp\ 1925}# #{e\ 1891}#)) - (let ((#{tmp\ 1926}# - ($sc-dispatch - #{tmp\ 1925}# - '(_ any . each-any)))) - (if #{tmp\ 1926}# - (@apply - (lambda (#{e1\ 1929}# #{e2\ 1930}#) - (#{chi-sequence\ 450}# - (cons #{e1\ 1929}# #{e2\ 1930}#) - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#)) - #{tmp\ 1926}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1925}#)))) - (if (eqv? #{type\ 1889}# 'local-syntax-form) - (#{chi-local-syntax\ 470}# - #{value\ 1890}# - #{e\ 1891}# - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}# - #{chi-sequence\ 450}#) - (if (eqv? #{type\ 1889}# 'eval-when-form) - (let ((#{tmp\ 1934}# #{e\ 1891}#)) - (let ((#{tmp\ 1935}# - ($sc-dispatch - #{tmp\ 1934}# - '(_ each-any any . each-any)))) - (if #{tmp\ 1935}# - (@apply - (lambda (#{x\ 1939}# - #{e1\ 1940}# - #{e2\ 1941}#) - (begin - (let ((#{when-list\ 1943}# - (#{chi-when-list\ 456}# - #{e\ 1891}# - #{x\ 1939}# - #{w\ 1893}#))) - (if (memq 'eval - #{when-list\ 1943}#) - (#{chi-sequence\ 450}# - (cons #{e1\ 1940}# - #{e2\ 1941}#) - #{r\ 1892}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#) - (#{chi-void\ 474}#))))) - #{tmp\ 1935}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1934}#)))) - (if (if (eqv? #{type\ 1889}# 'define-form) - #t - (eqv? #{type\ 1889}# - 'define-syntax-form)) - (syntax-violation - #f - "definition in expression context" - #{e\ 1891}# - (#{wrap\ 446}# - #{value\ 1890}# - #{w\ 1893}# - #{mod\ 1895}#)) - (if (eqv? #{type\ 1889}# 'syntax) - (syntax-violation - #f - "reference to pattern variable outside syntax form" - (#{source-wrap\ 448}# - #{e\ 1891}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#)) - (if (eqv? #{type\ 1889}# - 'displaced-lexical) - (syntax-violation - #f - "reference to identifier outside its scope" - (#{source-wrap\ 448}# - #{e\ 1891}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#)) - (syntax-violation - #f - "unexpected syntax" - (#{source-wrap\ 448}# - #{e\ 1891}# - #{w\ 1893}# - #{s\ 1894}# - #{mod\ 1895}#)))))))))))))))))) - (#{chi-application\ 464}# - (lambda (#{x\ 1950}# - #{e\ 1951}# - #{r\ 1952}# - #{w\ 1953}# - #{s\ 1954}# - #{mod\ 1955}#) - (let ((#{tmp\ 1962}# #{e\ 1951}#)) - (let ((#{tmp\ 1963}# - ($sc-dispatch #{tmp\ 1962}# '(any . each-any)))) - (if #{tmp\ 1963}# - (@apply - (lambda (#{e0\ 1966}# #{e1\ 1967}#) - (#{build-application\ 306}# - #{s\ 1954}# - #{x\ 1950}# - (map (lambda (#{e\ 1968}#) - (#{chi\ 460}# - #{e\ 1968}# - #{r\ 1952}# - #{w\ 1953}# - #{mod\ 1955}#)) - #{e1\ 1967}#))) - #{tmp\ 1963}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 1962}#)))))) - (#{chi-macro\ 466}# - (lambda (#{p\ 1971}# - #{e\ 1972}# - #{r\ 1973}# - #{w\ 1974}# - #{s\ 1975}# - #{rib\ 1976}# - #{mod\ 1977}#) - (letrec* - ((#{rebuild-macro-output\ 1986}# - (lambda (#{x\ 1987}# #{m\ 1988}#) - (if (pair? #{x\ 1987}#) - (#{decorate-source\ 300}# - (cons (#{rebuild-macro-output\ 1986}# - (car #{x\ 1987}#) - #{m\ 1988}#) - (#{rebuild-macro-output\ 1986}# - (cdr #{x\ 1987}#) - #{m\ 1988}#)) - #{s\ 1975}#) - (if (#{syntax-object?\ 346}# #{x\ 1987}#) - (begin - (let ((#{w\ 1996}# - (#{syntax-object-wrap\ 350}# #{x\ 1987}#))) - (begin - (let ((#{ms\ 1999}# (car #{w\ 1996}#)) - (#{s\ 2000}# (cdr #{w\ 1996}#))) - (if (if (pair? #{ms\ 1999}#) - (eq? (car #{ms\ 1999}#) #f) - #f) - (#{make-syntax-object\ 344}# - (#{syntax-object-expression\ 348}# - #{x\ 1987}#) - (cons (cdr #{ms\ 1999}#) - (if #{rib\ 1976}# - (cons #{rib\ 1976}# - (cdr #{s\ 2000}#)) - (cdr #{s\ 2000}#))) - (#{syntax-object-module\ 352}# - #{x\ 1987}#)) - (#{make-syntax-object\ 344}# - (#{decorate-source\ 300}# - (#{syntax-object-expression\ 348}# - #{x\ 1987}#) - #{s\ 2000}#) - (cons (cons #{m\ 1988}# #{ms\ 1999}#) - (if #{rib\ 1976}# - (cons #{rib\ 1976}# - (cons 'shift #{s\ 2000}#)) - (cons 'shift #{s\ 2000}#))) - (#{syntax-object-module\ 352}# - #{x\ 1987}#))))))) - (if (vector? #{x\ 1987}#) - (begin - (let ((#{n\ 2012}# (vector-length #{x\ 1987}#))) - (begin - (let ((#{v\ 2014}# - (#{decorate-source\ 300}# - (make-vector #{n\ 2012}#) - #{x\ 1987}#))) - (letrec* - ((#{loop\ 2017}# - (lambda (#{i\ 2018}#) - (if (#{fx=\ 287}# - #{i\ 2018}# - #{n\ 2012}#) - (begin (if #f #f) #{v\ 2014}#) - (begin - (vector-set! - #{v\ 2014}# - #{i\ 2018}# - (#{rebuild-macro-output\ 1986}# - (vector-ref - #{x\ 1987}# - #{i\ 2018}#) - #{m\ 1988}#)) - (#{loop\ 2017}# - (#{fx+\ 283}# - #{i\ 2018}# - 1))))))) - (begin (#{loop\ 2017}# 0))))))) - (if (symbol? #{x\ 1987}#) - (syntax-violation - #f - "encountered raw symbol in macro output" - (#{source-wrap\ 448}# - #{e\ 1972}# - #{w\ 1974}# - (cdr #{w\ 1974}#) - #{mod\ 1977}#) - #{x\ 1987}#) - (#{decorate-source\ 300}# - #{x\ 1987}# - #{s\ 1975}#)))))))) - (begin - (#{rebuild-macro-output\ 1986}# - (#{p\ 1971}# - (#{source-wrap\ 448}# - #{e\ 1972}# - (#{anti-mark\ 418}# #{w\ 1974}#) - #{s\ 1975}# - #{mod\ 1977}#)) - (gensym "m")))))) - (#{chi-body\ 468}# - (lambda (#{body\ 2026}# - #{outer-form\ 2027}# - #{r\ 2028}# - #{w\ 2029}# - #{mod\ 2030}#) - (begin - (let ((#{r\ 2038}# - (cons '("placeholder" placeholder) #{r\ 2028}#))) - (begin - (let ((#{ribcage\ 2040}# - (#{make-ribcage\ 398}# '() '() '()))) - (begin - (let ((#{w\ 2043}# - (cons (car #{w\ 2029}#) - (cons #{ribcage\ 2040}# - (cdr #{w\ 2029}#))))) - (letrec* - ((#{parse\ 2055}# - (lambda (#{body\ 2056}# - #{ids\ 2057}# - #{labels\ 2058}# - #{var-ids\ 2059}# - #{vars\ 2060}# - #{vals\ 2061}# - #{bindings\ 2062}#) - (if (null? #{body\ 2056}#) - (syntax-violation - #f - "no expressions in body" - #{outer-form\ 2027}#) - (begin - (let ((#{e\ 2067}# - (cdr (car #{body\ 2056}#))) - (#{er\ 2068}# - (car (car #{body\ 2056}#)))) - (call-with-values - (lambda () - (#{syntax-type\ 458}# - #{e\ 2067}# - #{er\ 2068}# - '(()) - (#{source-annotation\ 361}# - #{er\ 2068}#) - #{ribcage\ 2040}# - #{mod\ 2030}# - #f)) - (lambda (#{type\ 2070}# - #{value\ 2071}# - #{e\ 2072}# - #{w\ 2073}# - #{s\ 2074}# - #{mod\ 2075}#) - (if (eqv? #{type\ 2070}# - 'define-form) - (begin - (let ((#{id\ 2085}# - (#{wrap\ 446}# - #{value\ 2071}# - #{w\ 2073}# - #{mod\ 2075}#)) - (#{label\ 2086}# - (#{gen-label\ 393}#))) - (begin - (let ((#{var\ 2088}# - (#{gen-var\ 488}# - #{id\ 2085}#))) - (begin - (#{extend-ribcage!\ 422}# - #{ribcage\ 2040}# - #{id\ 2085}# - #{label\ 2086}#) - (#{parse\ 2055}# - (cdr #{body\ 2056}#) - (cons #{id\ 2085}# - #{ids\ 2057}#) - (cons #{label\ 2086}# - #{labels\ 2058}#) - (cons #{id\ 2085}# - #{var-ids\ 2059}#) - (cons #{var\ 2088}# - #{vars\ 2060}#) - (cons (cons #{er\ 2068}# - (#{wrap\ 446}# - #{e\ 2072}# - #{w\ 2073}# - #{mod\ 2075}#)) - #{vals\ 2061}#) - (cons (cons 'lexical - #{var\ 2088}#) - #{bindings\ 2062}#))))))) - (if (eqv? #{type\ 2070}# - 'define-syntax-form) - (begin - (let ((#{id\ 2093}# - (#{wrap\ 446}# - #{value\ 2071}# - #{w\ 2073}# - #{mod\ 2075}#)) - (#{label\ 2094}# - (#{gen-label\ 393}#))) - (begin - (#{extend-ribcage!\ 422}# - #{ribcage\ 2040}# - #{id\ 2093}# - #{label\ 2094}#) - (#{parse\ 2055}# - (cdr #{body\ 2056}#) - (cons #{id\ 2093}# - #{ids\ 2057}#) - (cons #{label\ 2094}# - #{labels\ 2058}#) - #{var-ids\ 2059}# - #{vars\ 2060}# - #{vals\ 2061}# - (cons (cons 'macro - (cons #{er\ 2068}# - (#{wrap\ 446}# - #{e\ 2072}# - #{w\ 2073}# - #{mod\ 2075}#))) - #{bindings\ 2062}#))))) - (if (eqv? #{type\ 2070}# - 'begin-form) - (let ((#{tmp\ 2097}# - #{e\ 2072}#)) - (let ((#{tmp\ 2098}# - ($sc-dispatch - #{tmp\ 2097}# - '(_ . each-any)))) - (if #{tmp\ 2098}# - (@apply - (lambda (#{e1\ 2100}#) - (#{parse\ 2055}# - (letrec* - ((#{f\ 2103}# - (lambda (#{forms\ 2104}#) - (if (null? #{forms\ 2104}#) - (cdr #{body\ 2056}#) - (cons (cons #{er\ 2068}# - (#{wrap\ 446}# - (car #{forms\ 2104}#) - #{w\ 2073}# - #{mod\ 2075}#)) - (#{f\ 2103}# - (cdr #{forms\ 2104}#))))))) - (begin - (#{f\ 2103}# - #{e1\ 2100}#))) - #{ids\ 2057}# - #{labels\ 2058}# - #{var-ids\ 2059}# - #{vars\ 2060}# - #{vals\ 2061}# - #{bindings\ 2062}#)) - #{tmp\ 2098}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 2097}#)))) - (if (eqv? #{type\ 2070}# - 'local-syntax-form) - (#{chi-local-syntax\ 470}# - #{value\ 2071}# - #{e\ 2072}# - #{er\ 2068}# - #{w\ 2073}# - #{s\ 2074}# - #{mod\ 2075}# - (lambda (#{forms\ 2107}# - #{er\ 2108}# - #{w\ 2109}# - #{s\ 2110}# - #{mod\ 2111}#) - (#{parse\ 2055}# - (letrec* - ((#{f\ 2119}# - (lambda (#{forms\ 2120}#) - (if (null? #{forms\ 2120}#) - (cdr #{body\ 2056}#) - (cons (cons #{er\ 2108}# - (#{wrap\ 446}# - (car #{forms\ 2120}#) - #{w\ 2109}# - #{mod\ 2111}#)) - (#{f\ 2119}# - (cdr #{forms\ 2120}#))))))) - (begin - (#{f\ 2119}# - #{forms\ 2107}#))) - #{ids\ 2057}# - #{labels\ 2058}# - #{var-ids\ 2059}# - #{vars\ 2060}# - #{vals\ 2061}# - #{bindings\ 2062}#))) - (if (null? #{ids\ 2057}#) - (#{build-sequence\ 334}# - #f - (map (lambda (#{x\ 2123}#) - (#{chi\ 460}# - (cdr #{x\ 2123}#) - (car #{x\ 2123}#) - '(()) - #{mod\ 2075}#)) - (cons (cons #{er\ 2068}# - (#{source-wrap\ 448}# - #{e\ 2072}# - #{w\ 2073}# - #{s\ 2074}# - #{mod\ 2075}#)) - (cdr #{body\ 2056}#)))) - (begin - (if (not (#{valid-bound-ids?\ 440}# - #{ids\ 2057}#)) - (syntax-violation - #f - "invalid or duplicate identifier in definition" - #{outer-form\ 2027}#)) - (letrec* - ((#{loop\ 2130}# - (lambda (#{bs\ 2131}# - #{er-cache\ 2132}# - #{r-cache\ 2133}#) - (if (not (null? #{bs\ 2131}#)) - (begin - (let ((#{b\ 2136}# - (car #{bs\ 2131}#))) - (if (eq? (car #{b\ 2136}#) - 'macro) - (begin - (let ((#{er\ 2139}# - (car (cdr #{b\ 2136}#)))) - (begin - (let ((#{r-cache\ 2141}# - (if (eq? #{er\ 2139}# - #{er-cache\ 2132}#) - #{r-cache\ 2133}# - (#{macros-only-env\ 372}# - #{er\ 2139}#)))) - (begin - (set-cdr! - #{b\ 2136}# - (#{eval-local-transformer\ 472}# - (#{chi\ 460}# - (cdr (cdr #{b\ 2136}#)) - #{r-cache\ 2141}# - '(()) - #{mod\ 2075}#) - #{mod\ 2075}#)) - (#{loop\ 2130}# - (cdr #{bs\ 2131}#) - #{er\ 2139}# - #{r-cache\ 2141}#)))))) - (#{loop\ 2130}# - (cdr #{bs\ 2131}#) - #{er-cache\ 2132}# - #{r-cache\ 2133}#)))))))) - (begin - (#{loop\ 2130}# - #{bindings\ 2062}# - #f - #f))) - (set-cdr! - #{r\ 2038}# - (#{extend-env\ 368}# - #{labels\ 2058}# - #{bindings\ 2062}# - (cdr #{r\ 2038}#))) - (#{build-letrec\ 340}# - #f - #t - (reverse - (map syntax->datum - #{var-ids\ 2059}#)) - (reverse - #{vars\ 2060}#) - (map (lambda (#{x\ 2144}#) - (#{chi\ 460}# - (cdr #{x\ 2144}#) - (car #{x\ 2144}#) - '(()) - #{mod\ 2075}#)) - (reverse - #{vals\ 2061}#)) - (#{build-sequence\ 334}# - #f - (map (lambda (#{x\ 2148}#) - (#{chi\ 460}# - (cdr #{x\ 2148}#) - (car #{x\ 2148}#) - '(()) - #{mod\ 2075}#)) - (cons (cons #{er\ 2068}# - (#{source-wrap\ 448}# - #{e\ 2072}# - #{w\ 2073}# - #{s\ 2074}# - #{mod\ 2075}#)) - (cdr #{body\ 2056}#))))))))))))))))))) - (begin - (#{parse\ 2055}# - (map (lambda (#{x\ 2063}#) - (cons #{r\ 2038}# - (#{wrap\ 446}# - #{x\ 2063}# - #{w\ 2043}# - #{mod\ 2030}#))) - #{body\ 2026}#) - '() - '() - '() - '() - '() - '()))))))))))) - (#{chi-local-syntax\ 470}# - (lambda (#{rec?\ 2151}# - #{e\ 2152}# - #{r\ 2153}# - #{w\ 2154}# - #{s\ 2155}# - #{mod\ 2156}# - #{k\ 2157}#) - (let ((#{tmp\ 2165}# #{e\ 2152}#)) - (let ((#{tmp\ 2166}# - ($sc-dispatch - #{tmp\ 2165}# - '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 2166}# - (@apply - (lambda (#{id\ 2171}# - #{val\ 2172}# - #{e1\ 2173}# - #{e2\ 2174}#) - (begin - (let ((#{ids\ 2176}# #{id\ 2171}#)) - (if (not (#{valid-bound-ids?\ 440}# #{ids\ 2176}#)) - (syntax-violation - #f - "duplicate bound keyword" - #{e\ 2152}#) + (#{syntax-object-expression\ 344}# #{x\ 1249}#)) + #f)))) + (#{id-sym-name&marks\ 379}# + (lambda (#{x\ 1256}# #{w\ 1257}#) + (if (#{syntax-object?\ 342}# #{x\ 1256}#) + (values + (#{syntax-object-expression\ 344}# #{x\ 1256}#) + (#{join-marks\ 426}# + (car #{w\ 1257}#) + (car (#{syntax-object-wrap\ 346}# #{x\ 1256}#)))) + (values #{x\ 1256}# (car #{w\ 1257}#))))) + (#{gen-label\ 389}# + (lambda () (symbol->string (gensym "i")))) + (#{gen-labels\ 391}# + (lambda (#{ls\ 1263}#) + (if (null? #{ls\ 1263}#) + '() + (cons (#{gen-label\ 389}#) + (#{gen-labels\ 391}# (cdr #{ls\ 1263}#)))))) + (#{make-ribcage\ 394}# + (lambda (#{symnames\ 1265}# + #{marks\ 1266}# + #{labels\ 1267}#) + (vector + 'ribcage + #{symnames\ 1265}# + #{marks\ 1266}# + #{labels\ 1267}#))) + (#{ribcage-symnames\ 398}# + (lambda (#{x\ 1276}#) (vector-ref #{x\ 1276}# 1))) + (#{ribcage-marks\ 400}# + (lambda (#{x\ 1278}#) (vector-ref #{x\ 1278}# 2))) + (#{ribcage-labels\ 402}# + (lambda (#{x\ 1280}#) (vector-ref #{x\ 1280}# 3))) + (#{set-ribcage-symnames!\ 404}# + (lambda (#{x\ 1282}# #{update\ 1283}#) + (vector-set! #{x\ 1282}# 1 #{update\ 1283}#))) + (#{set-ribcage-marks!\ 406}# + (lambda (#{x\ 1286}# #{update\ 1287}#) + (vector-set! #{x\ 1286}# 2 #{update\ 1287}#))) + (#{set-ribcage-labels!\ 408}# + (lambda (#{x\ 1290}# #{update\ 1291}#) + (vector-set! #{x\ 1290}# 3 #{update\ 1291}#))) + (#{anti-mark\ 414}# + (lambda (#{w\ 1294}#) + (cons (cons #f (car #{w\ 1294}#)) + (cons 'shift (cdr #{w\ 1294}#))))) + (#{extend-ribcage!\ 418}# + (lambda (#{ribcage\ 1300}# #{id\ 1301}# #{label\ 1302}#) + (begin + (#{set-ribcage-symnames!\ 404}# + #{ribcage\ 1300}# + (cons (#{syntax-object-expression\ 344}# #{id\ 1301}#) + (#{ribcage-symnames\ 398}# #{ribcage\ 1300}#))) + (#{set-ribcage-marks!\ 406}# + #{ribcage\ 1300}# + (cons (car (#{syntax-object-wrap\ 346}# #{id\ 1301}#)) + (#{ribcage-marks\ 400}# #{ribcage\ 1300}#))) + (#{set-ribcage-labels!\ 408}# + #{ribcage\ 1300}# + (cons #{label\ 1302}# + (#{ribcage-labels\ 402}# #{ribcage\ 1300}#)))))) + (#{make-binding-wrap\ 420}# + (lambda (#{ids\ 1307}# #{labels\ 1308}# #{w\ 1309}#) + (if (null? #{ids\ 1307}#) + #{w\ 1309}# + (cons (car #{w\ 1309}#) + (cons (begin + (let ((#{labelvec\ 1316}# + (list->vector #{labels\ 1308}#))) (begin - (let ((#{labels\ 2179}# - (#{gen-labels\ 395}# #{ids\ 2176}#))) + (let ((#{n\ 1318}# + (vector-length #{labelvec\ 1316}#))) (begin - (let ((#{new-w\ 2181}# - (#{make-binding-wrap\ 424}# - #{ids\ 2176}# - #{labels\ 2179}# - #{w\ 2154}#))) - (#{k\ 2157}# - (cons #{e1\ 2173}# #{e2\ 2174}#) - (#{extend-env\ 368}# - #{labels\ 2179}# - (begin - (let ((#{w\ 2185}# - (if #{rec?\ 2151}# - #{new-w\ 2181}# - #{w\ 2154}#)) - (#{trans-r\ 2186}# - (#{macros-only-env\ 372}# - #{r\ 2153}#))) - (map (lambda (#{x\ 2187}#) - (cons 'macro - (#{eval-local-transformer\ 472}# - (#{chi\ 460}# - #{x\ 2187}# - #{trans-r\ 2186}# - #{w\ 2185}# - #{mod\ 2156}#) - #{mod\ 2156}#))) - #{val\ 2172}#))) - #{r\ 2153}#) - #{new-w\ 2181}# - #{s\ 2155}# - #{mod\ 2156}#))))))))) - #{tmp\ 2166}#) - (let ((#{_\ 2192}# #{tmp\ 2165}#)) - (syntax-violation - #f - "bad local syntax definition" - (#{source-wrap\ 448}# - #{e\ 2152}# - #{w\ 2154}# - #{s\ 2155}# - #{mod\ 2156}#)))))))) - (#{eval-local-transformer\ 472}# - (lambda (#{expanded\ 2193}# #{mod\ 2194}#) - (begin - (let ((#{p\ 2198}# - (#{local-eval-hook\ 293}# - #{expanded\ 2193}# - #{mod\ 2194}#))) - (if (procedure? #{p\ 2198}#) - #{p\ 2198}# - (syntax-violation - #f - "nonprocedure transformer" - #{p\ 2198}#)))))) - (#{chi-void\ 474}# - (lambda () (#{build-void\ 304}# #f))) - (#{ellipsis?\ 476}# - (lambda (#{x\ 2200}#) - (if (#{nonsymbol-id?\ 378}# #{x\ 2200}#) - (#{free-id=?\ 436}# - #{x\ 2200}# - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i2201")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile))) - #f))) - (#{lambda-formals\ 478}# - (lambda (#{orig-args\ 2204}#) - (letrec* - ((#{req\ 2207}# - (lambda (#{args\ 2210}# #{rreq\ 2211}#) - (let ((#{tmp\ 2214}# #{args\ 2210}#)) - (let ((#{tmp\ 2215}# ($sc-dispatch #{tmp\ 2214}# '()))) - (if #{tmp\ 2215}# - (@apply - (lambda () - (#{check\ 2209}# (reverse #{rreq\ 2211}#) #f)) - #{tmp\ 2215}#) - (let ((#{tmp\ 2216}# - ($sc-dispatch #{tmp\ 2214}# '(any . any)))) - (if (if #{tmp\ 2216}# - (@apply - (lambda (#{a\ 2219}# #{b\ 2220}#) - (#{id?\ 380}# #{a\ 2219}#)) - #{tmp\ 2216}#) - #f) - (@apply - (lambda (#{a\ 2223}# #{b\ 2224}#) - (#{req\ 2207}# - #{b\ 2224}# - (cons #{a\ 2223}# #{rreq\ 2211}#))) - #{tmp\ 2216}#) - (let ((#{tmp\ 2225}# (list #{tmp\ 2214}#))) - (if (if #{tmp\ 2225}# - (@apply - (lambda (#{r\ 2227}#) - (#{id?\ 380}# #{r\ 2227}#)) - #{tmp\ 2225}#) - #f) - (@apply - (lambda (#{r\ 2229}#) - (#{check\ 2209}# - (reverse #{rreq\ 2211}#) - #{r\ 2229}#)) - #{tmp\ 2225}#) - (let ((#{else\ 2231}# #{tmp\ 2214}#)) - (syntax-violation - 'lambda - "invalid argument list" - #{orig-args\ 2204}# - #{args\ 2210}#))))))))))) - (#{check\ 2209}# - (lambda (#{req\ 2232}# #{rest\ 2233}#) - (if (#{distinct-bound-ids?\ 442}# - (if #{rest\ 2233}# - (cons #{rest\ 2233}# #{req\ 2232}#) - #{req\ 2232}#)) - (values #{req\ 2232}# #f #{rest\ 2233}# #f) - (syntax-violation - 'lambda - "duplicate identifier in argument list" - #{orig-args\ 2204}#))))) - (begin (#{req\ 2207}# #{orig-args\ 2204}# '()))))) - (#{chi-simple-lambda\ 480}# - (lambda (#{e\ 2239}# - #{r\ 2240}# - #{w\ 2241}# - #{s\ 2242}# - #{mod\ 2243}# - #{req\ 2244}# - #{rest\ 2245}# - #{meta\ 2246}# - #{body\ 2247}#) - (begin - (let ((#{ids\ 2259}# - (if #{rest\ 2245}# - (append #{req\ 2244}# (list #{rest\ 2245}#)) - #{req\ 2244}#))) - (begin - (let ((#{vars\ 2261}# - (map #{gen-var\ 488}# #{ids\ 2259}#))) - (begin - (let ((#{labels\ 2263}# - (#{gen-labels\ 395}# #{ids\ 2259}#))) - (#{build-simple-lambda\ 324}# - #{s\ 2242}# - (map syntax->datum #{req\ 2244}#) - (if #{rest\ 2245}# - (syntax->datum #{rest\ 2245}#) - #f) - #{vars\ 2261}# - #{meta\ 2246}# - (#{chi-body\ 468}# - #{body\ 2247}# - (#{source-wrap\ 448}# - #{e\ 2239}# - #{w\ 2241}# - #{s\ 2242}# - #{mod\ 2243}#) - (#{extend-var-env\ 370}# - #{labels\ 2263}# - #{vars\ 2261}# - #{r\ 2240}#) - (#{make-binding-wrap\ 424}# - #{ids\ 2259}# - #{labels\ 2263}# - #{w\ 2241}#) - #{mod\ 2243}#)))))))))) - (#{lambda*-formals\ 482}# - (lambda (#{orig-args\ 2266}#) - (letrec* - ((#{req\ 2269}# - (lambda (#{args\ 2278}# #{rreq\ 2279}#) - (let ((#{tmp\ 2282}# #{args\ 2278}#)) - (let ((#{tmp\ 2283}# ($sc-dispatch #{tmp\ 2282}# '()))) - (if #{tmp\ 2283}# - (@apply - (lambda () - (#{check\ 2277}# - (reverse #{rreq\ 2279}#) - '() - #f - '())) - #{tmp\ 2283}#) - (let ((#{tmp\ 2284}# - ($sc-dispatch #{tmp\ 2282}# '(any . any)))) - (if (if #{tmp\ 2284}# - (@apply - (lambda (#{a\ 2287}# #{b\ 2288}#) - (#{id?\ 380}# #{a\ 2287}#)) - #{tmp\ 2284}#) - #f) - (@apply - (lambda (#{a\ 2291}# #{b\ 2292}#) - (#{req\ 2269}# - #{b\ 2292}# - (cons #{a\ 2291}# #{rreq\ 2279}#))) - #{tmp\ 2284}#) - (let ((#{tmp\ 2293}# - ($sc-dispatch - #{tmp\ 2282}# - '(any . any)))) - (if (if #{tmp\ 2293}# - (@apply - (lambda (#{a\ 2296}# #{b\ 2297}#) - (eq? (syntax->datum #{a\ 2296}#) - #:optional)) - #{tmp\ 2293}#) - #f) - (@apply - (lambda (#{a\ 2300}# #{b\ 2301}#) - (#{opt\ 2271}# - #{b\ 2301}# - (reverse #{rreq\ 2279}#) - '())) - #{tmp\ 2293}#) - (let ((#{tmp\ 2302}# - ($sc-dispatch - #{tmp\ 2282}# - '(any . any)))) - (if (if #{tmp\ 2302}# - (@apply - (lambda (#{a\ 2305}# #{b\ 2306}#) - (eq? (syntax->datum #{a\ 2305}#) - #:key)) - #{tmp\ 2302}#) - #f) - (@apply - (lambda (#{a\ 2309}# #{b\ 2310}#) - (#{key\ 2273}# - #{b\ 2310}# - (reverse #{rreq\ 2279}#) - '() - '())) - #{tmp\ 2302}#) - (let ((#{tmp\ 2311}# - ($sc-dispatch - #{tmp\ 2282}# - '(any any)))) - (if (if #{tmp\ 2311}# - (@apply - (lambda (#{a\ 2314}# - #{b\ 2315}#) - (eq? (syntax->datum - #{a\ 2314}#) - #:rest)) - #{tmp\ 2311}#) - #f) - (@apply - (lambda (#{a\ 2318}# #{b\ 2319}#) - (#{rest\ 2275}# - #{b\ 2319}# - (reverse #{rreq\ 2279}#) - '() - '())) - #{tmp\ 2311}#) - (let ((#{tmp\ 2320}# - (list #{tmp\ 2282}#))) - (if (if #{tmp\ 2320}# - (@apply - (lambda (#{r\ 2322}#) - (#{id?\ 380}# - #{r\ 2322}#)) - #{tmp\ 2320}#) - #f) - (@apply - (lambda (#{r\ 2324}#) - (#{rest\ 2275}# - #{r\ 2324}# - (reverse #{rreq\ 2279}#) - '() - '())) - #{tmp\ 2320}#) - (let ((#{else\ 2326}# - #{tmp\ 2282}#)) - (syntax-violation - 'lambda* - "invalid argument list" - #{orig-args\ 2266}# - #{args\ 2278}#))))))))))))))))) - (#{opt\ 2271}# - (lambda (#{args\ 2327}# #{req\ 2328}# #{ropt\ 2329}#) - (let ((#{tmp\ 2333}# #{args\ 2327}#)) - (let ((#{tmp\ 2334}# ($sc-dispatch #{tmp\ 2333}# '()))) - (if #{tmp\ 2334}# - (@apply - (lambda () - (#{check\ 2277}# - #{req\ 2328}# - (reverse #{ropt\ 2329}#) - #f - '())) - #{tmp\ 2334}#) - (let ((#{tmp\ 2335}# - ($sc-dispatch #{tmp\ 2333}# '(any . any)))) - (if (if #{tmp\ 2335}# - (@apply - (lambda (#{a\ 2338}# #{b\ 2339}#) - (#{id?\ 380}# #{a\ 2338}#)) - #{tmp\ 2335}#) - #f) - (@apply - (lambda (#{a\ 2342}# #{b\ 2343}#) - (#{opt\ 2271}# - #{b\ 2343}# - #{req\ 2328}# - (cons (cons #{a\ 2342}# - '(#(syntax-object - #f - ((top) - #(ribcage - #(a b) - #((top) (top)) - #("i2340" "i2341")) - #(ribcage () () ()) - #(ribcage - #(args req ropt) - #((top) (top) (top)) - #("i2330" - "i2331" - "i2332")) - #(ribcage - (check rest key opt req) - ((top) - (top) - (top) - (top) - (top)) - ("i2276" - "i2274" - "i2272" - "i2270" - "i2268")) - #(ribcage - #(orig-args) - #((top)) - #("i2267")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) - (top) - (top) - (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene guile)))) - #{ropt\ 2329}#))) - #{tmp\ 2335}#) - (let ((#{tmp\ 2344}# - ($sc-dispatch - #{tmp\ 2333}# - '((any any) . any)))) - (if (if #{tmp\ 2344}# - (@apply - (lambda (#{a\ 2348}# - #{init\ 2349}# - #{b\ 2350}#) - (#{id?\ 380}# #{a\ 2348}#)) - #{tmp\ 2344}#) - #f) - (@apply - (lambda (#{a\ 2354}# - #{init\ 2355}# - #{b\ 2356}#) - (#{opt\ 2271}# - #{b\ 2356}# - #{req\ 2328}# - (cons (list #{a\ 2354}# #{init\ 2355}#) - #{ropt\ 2329}#))) - #{tmp\ 2344}#) - (let ((#{tmp\ 2357}# - ($sc-dispatch - #{tmp\ 2333}# - '(any . any)))) - (if (if #{tmp\ 2357}# - (@apply - (lambda (#{a\ 2360}# #{b\ 2361}#) - (eq? (syntax->datum #{a\ 2360}#) - #:key)) - #{tmp\ 2357}#) - #f) - (@apply - (lambda (#{a\ 2364}# #{b\ 2365}#) - (#{key\ 2273}# - #{b\ 2365}# - #{req\ 2328}# - (reverse #{ropt\ 2329}#) - '())) - #{tmp\ 2357}#) - (let ((#{tmp\ 2366}# - ($sc-dispatch - #{tmp\ 2333}# - '(any any)))) - (if (if #{tmp\ 2366}# - (@apply - (lambda (#{a\ 2369}# - #{b\ 2370}#) - (eq? (syntax->datum - #{a\ 2369}#) - #:rest)) - #{tmp\ 2366}#) - #f) - (@apply - (lambda (#{a\ 2373}# #{b\ 2374}#) - (#{rest\ 2275}# - #{b\ 2374}# - #{req\ 2328}# - (reverse #{ropt\ 2329}#) - '())) - #{tmp\ 2366}#) - (let ((#{tmp\ 2375}# - (list #{tmp\ 2333}#))) - (if (if #{tmp\ 2375}# - (@apply - (lambda (#{r\ 2377}#) - (#{id?\ 380}# - #{r\ 2377}#)) - #{tmp\ 2375}#) - #f) - (@apply - (lambda (#{r\ 2379}#) - (#{rest\ 2275}# - #{r\ 2379}# - #{req\ 2328}# - (reverse #{ropt\ 2329}#) - '())) - #{tmp\ 2375}#) - (let ((#{else\ 2381}# - #{tmp\ 2333}#)) - (syntax-violation - 'lambda* - "invalid optional argument list" - #{orig-args\ 2266}# - #{args\ 2327}#))))))))))))))))) - (#{key\ 2273}# - (lambda (#{args\ 2382}# - #{req\ 2383}# - #{opt\ 2384}# - #{rkey\ 2385}#) - (let ((#{tmp\ 2390}# #{args\ 2382}#)) - (let ((#{tmp\ 2391}# ($sc-dispatch #{tmp\ 2390}# '()))) - (if #{tmp\ 2391}# - (@apply - (lambda () - (#{check\ 2277}# - #{req\ 2383}# - #{opt\ 2384}# - #f - (cons #f (reverse #{rkey\ 2385}#)))) - #{tmp\ 2391}#) - (let ((#{tmp\ 2392}# - ($sc-dispatch #{tmp\ 2390}# '(any . any)))) - (if (if #{tmp\ 2392}# - (@apply - (lambda (#{a\ 2395}# #{b\ 2396}#) - (#{id?\ 380}# #{a\ 2395}#)) - #{tmp\ 2392}#) - #f) - (@apply - (lambda (#{a\ 2399}# #{b\ 2400}#) - (let ((#{tmp\ 2402}# - (symbol->keyword - (syntax->datum #{a\ 2399}#)))) - (let ((#{k\ 2404}# #{tmp\ 2402}#)) - (#{key\ 2273}# - #{b\ 2400}# - #{req\ 2383}# - #{opt\ 2384}# - (cons (cons #{k\ 2404}# - (cons #{a\ 2399}# - '(#(syntax-object - #f - ((top) - #(ribcage - () - () - ()) - #(ribcage - #(k) - #((top)) - #("i2403")) - #(ribcage - #(a b) - #((top) (top)) - #("i2397" - "i2398")) - #(ribcage - () - () - ()) - #(ribcage - #(args - req - opt - rkey) - #((top) - (top) - (top) - (top)) - #("i2386" - "i2387" - "i2388" - "i2389")) - #(ribcage - (check rest - key - opt - req) - ((top) - (top) - (top) - (top) - (top)) - ("i2276" - "i2274" - "i2272" - "i2270" - "i2268")) - #(ribcage - #(orig-args) - #((top)) - #("i2267")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) - (top) - (top) - (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene - guile))))) - #{rkey\ 2385}#))))) - #{tmp\ 2392}#) - (let ((#{tmp\ 2405}# - ($sc-dispatch - #{tmp\ 2390}# - '((any any) . any)))) - (if (if #{tmp\ 2405}# - (@apply - (lambda (#{a\ 2409}# - #{init\ 2410}# - #{b\ 2411}#) - (#{id?\ 380}# #{a\ 2409}#)) - #{tmp\ 2405}#) - #f) - (@apply - (lambda (#{a\ 2415}# - #{init\ 2416}# - #{b\ 2417}#) - (let ((#{tmp\ 2419}# - (symbol->keyword - (syntax->datum #{a\ 2415}#)))) - (let ((#{k\ 2421}# #{tmp\ 2419}#)) - (#{key\ 2273}# - #{b\ 2417}# - #{req\ 2383}# - #{opt\ 2384}# - (cons (list #{k\ 2421}# - #{a\ 2415}# - #{init\ 2416}#) - #{rkey\ 2385}#))))) - #{tmp\ 2405}#) - (let ((#{tmp\ 2422}# - ($sc-dispatch - #{tmp\ 2390}# - '((any any any) . any)))) - (if (if #{tmp\ 2422}# - (@apply - (lambda (#{a\ 2427}# - #{init\ 2428}# - #{k\ 2429}# - #{b\ 2430}#) - (if (#{id?\ 380}# #{a\ 2427}#) - (keyword? - (syntax->datum #{k\ 2429}#)) - #f)) - #{tmp\ 2422}#) - #f) - (@apply - (lambda (#{a\ 2437}# - #{init\ 2438}# - #{k\ 2439}# - #{b\ 2440}#) - (#{key\ 2273}# - #{b\ 2440}# - #{req\ 2383}# - #{opt\ 2384}# - (cons (list #{k\ 2439}# - #{a\ 2437}# - #{init\ 2438}#) - #{rkey\ 2385}#))) - #{tmp\ 2422}#) - (let ((#{tmp\ 2441}# - ($sc-dispatch - #{tmp\ 2390}# - '(any)))) - (if (if #{tmp\ 2441}# - (@apply - (lambda (#{aok\ 2443}#) - (eq? (syntax->datum - #{aok\ 2443}#) - #:allow-other-keys)) - #{tmp\ 2441}#) - #f) - (@apply - (lambda (#{aok\ 2445}#) - (#{check\ 2277}# - #{req\ 2383}# - #{opt\ 2384}# - #f - (cons #t - (reverse - #{rkey\ 2385}#)))) - #{tmp\ 2441}#) - (let ((#{tmp\ 2446}# - ($sc-dispatch - #{tmp\ 2390}# - '(any any any)))) - (if (if #{tmp\ 2446}# - (@apply - (lambda (#{aok\ 2450}# - #{a\ 2451}# - #{b\ 2452}#) - (if (eq? (syntax->datum - #{aok\ 2450}#) - #:allow-other-keys) - (eq? (syntax->datum - #{a\ 2451}#) - #:rest) - #f)) - #{tmp\ 2446}#) - #f) - (@apply - (lambda (#{aok\ 2458}# - #{a\ 2459}# - #{b\ 2460}#) - (#{rest\ 2275}# - #{b\ 2460}# - #{req\ 2383}# - #{opt\ 2384}# - (cons #t - (reverse - #{rkey\ 2385}#)))) - #{tmp\ 2446}#) - (let ((#{tmp\ 2461}# - ($sc-dispatch - #{tmp\ 2390}# - '(any . any)))) - (if (if #{tmp\ 2461}# - (@apply - (lambda (#{aok\ 2464}# - #{r\ 2465}#) - (if (eq? (syntax->datum - #{aok\ 2464}#) - #:allow-other-keys) - (#{id?\ 380}# - #{r\ 2465}#) - #f)) - #{tmp\ 2461}#) - #f) - (@apply - (lambda (#{aok\ 2470}# - #{r\ 2471}#) - (#{rest\ 2275}# - #{r\ 2471}# - #{req\ 2383}# - #{opt\ 2384}# - (cons #t - (reverse - #{rkey\ 2385}#)))) - #{tmp\ 2461}#) - (let ((#{tmp\ 2472}# - ($sc-dispatch - #{tmp\ 2390}# - '(any any)))) - (if (if #{tmp\ 2472}# - (@apply - (lambda (#{a\ 2475}# - #{b\ 2476}#) - (eq? (syntax->datum - #{a\ 2475}#) - #:rest)) - #{tmp\ 2472}#) - #f) - (@apply - (lambda (#{a\ 2479}# - #{b\ 2480}#) - (#{rest\ 2275}# - #{b\ 2480}# - #{req\ 2383}# - #{opt\ 2384}# - (cons #f - (reverse - #{rkey\ 2385}#)))) - #{tmp\ 2472}#) - (let ((#{tmp\ 2481}# - (list #{tmp\ 2390}#))) - (if (if #{tmp\ 2481}# - (@apply - (lambda (#{r\ 2483}#) - (#{id?\ 380}# - #{r\ 2483}#)) - #{tmp\ 2481}#) - #f) - (@apply - (lambda (#{r\ 2485}#) - (#{rest\ 2275}# - #{r\ 2485}# - #{req\ 2383}# - #{opt\ 2384}# - (cons #f - (reverse - #{rkey\ 2385}#)))) - #{tmp\ 2481}#) - (let ((#{else\ 2487}# - #{tmp\ 2390}#)) - (syntax-violation - 'lambda* - "invalid keyword argument list" - #{orig-args\ 2266}# - #{args\ 2382}#))))))))))))))))))))))) - (#{rest\ 2275}# - (lambda (#{args\ 2488}# - #{req\ 2489}# - #{opt\ 2490}# - #{kw\ 2491}#) - (let ((#{tmp\ 2496}# #{args\ 2488}#)) - (let ((#{tmp\ 2497}# (list #{tmp\ 2496}#))) - (if (if #{tmp\ 2497}# - (@apply - (lambda (#{r\ 2499}#) - (#{id?\ 380}# #{r\ 2499}#)) - #{tmp\ 2497}#) - #f) - (@apply - (lambda (#{r\ 2501}#) - (#{check\ 2277}# - #{req\ 2489}# - #{opt\ 2490}# - #{r\ 2501}# - #{kw\ 2491}#)) - #{tmp\ 2497}#) - (let ((#{else\ 2503}# #{tmp\ 2496}#)) - (syntax-violation - 'lambda* - "invalid rest argument" - #{orig-args\ 2266}# - #{args\ 2488}#))))))) - (#{check\ 2277}# - (lambda (#{req\ 2504}# - #{opt\ 2505}# - #{rest\ 2506}# - #{kw\ 2507}#) - (if (#{distinct-bound-ids?\ 442}# - (append - #{req\ 2504}# - (map car #{opt\ 2505}#) - (if #{rest\ 2506}# (list #{rest\ 2506}#) '()) - (if (pair? #{kw\ 2507}#) - (map cadr (cdr #{kw\ 2507}#)) - '()))) - (values - #{req\ 2504}# - #{opt\ 2505}# - #{rest\ 2506}# - #{kw\ 2507}#) - (syntax-violation - 'lambda* - "duplicate identifier in argument list" - #{orig-args\ 2266}#))))) - (begin (#{req\ 2269}# #{orig-args\ 2266}# '()))))) - (#{chi-lambda-case\ 484}# - (lambda (#{e\ 2515}# - #{r\ 2516}# - #{w\ 2517}# - #{s\ 2518}# - #{mod\ 2519}# - #{get-formals\ 2520}# - #{clauses\ 2521}#) - (letrec* - ((#{expand-req\ 2530}# - (lambda (#{req\ 2537}# - #{opt\ 2538}# - #{rest\ 2539}# - #{kw\ 2540}# - #{body\ 2541}#) - (begin - (let ((#{vars\ 2549}# - (map #{gen-var\ 488}# #{req\ 2537}#)) - (#{labels\ 2550}# - (#{gen-labels\ 395}# #{req\ 2537}#))) - (begin - (let ((#{r*\ 2553}# - (#{extend-var-env\ 370}# - #{labels\ 2550}# - #{vars\ 2549}# - #{r\ 2516}#)) - (#{w*\ 2554}# - (#{make-binding-wrap\ 424}# - #{req\ 2537}# - #{labels\ 2550}# - #{w\ 2517}#))) - (#{expand-opt\ 2532}# - (map syntax->datum #{req\ 2537}#) - #{opt\ 2538}# - #{rest\ 2539}# - #{kw\ 2540}# - #{body\ 2541}# - (reverse #{vars\ 2549}#) - #{r*\ 2553}# - #{w*\ 2554}# - '() - '()))))))) - (#{expand-opt\ 2532}# - (lambda (#{req\ 2555}# - #{opt\ 2556}# - #{rest\ 2557}# - #{kw\ 2558}# - #{body\ 2559}# - #{vars\ 2560}# - #{r*\ 2561}# - #{w*\ 2562}# - #{out\ 2563}# - #{inits\ 2564}#) - (if (pair? #{opt\ 2556}#) - (let ((#{tmp\ 2577}# (car #{opt\ 2556}#))) - (let ((#{tmp\ 2578}# - ($sc-dispatch #{tmp\ 2577}# '(any any)))) - (if #{tmp\ 2578}# - (@apply - (lambda (#{id\ 2581}# #{i\ 2582}#) - (begin - (let ((#{v\ 2585}# - (#{gen-var\ 488}# #{id\ 2581}#))) - (begin - (let ((#{l\ 2587}# - (#{gen-labels\ 395}# - (list #{v\ 2585}#)))) - (begin - (let ((#{r**\ 2589}# - (#{extend-var-env\ 370}# - #{l\ 2587}# - (list #{v\ 2585}#) - #{r*\ 2561}#))) - (begin - (let ((#{w**\ 2591}# - (#{make-binding-wrap\ 424}# - (list #{id\ 2581}#) - #{l\ 2587}# - #{w*\ 2562}#))) - (#{expand-opt\ 2532}# - #{req\ 2555}# - (cdr #{opt\ 2556}#) - #{rest\ 2557}# - #{kw\ 2558}# - #{body\ 2559}# - (cons #{v\ 2585}# - #{vars\ 2560}#) - #{r**\ 2589}# - #{w**\ 2591}# - (cons (syntax->datum - #{id\ 2581}#) - #{out\ 2563}#) - (cons (#{chi\ 460}# - #{i\ 2582}# - #{r*\ 2561}# - #{w*\ 2562}# - #{mod\ 2519}#) - #{inits\ 2564}#))))))))))) - #{tmp\ 2578}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 2577}#)))) - (if #{rest\ 2557}# - (begin - (let ((#{v\ 2596}# - (#{gen-var\ 488}# #{rest\ 2557}#))) - (begin - (let ((#{l\ 2598}# - (#{gen-labels\ 395}# - (list #{v\ 2596}#)))) - (begin - (let ((#{r*\ 2600}# - (#{extend-var-env\ 370}# - #{l\ 2598}# - (list #{v\ 2596}#) - #{r*\ 2561}#))) - (begin - (let ((#{w*\ 2602}# - (#{make-binding-wrap\ 424}# - (list #{rest\ 2557}#) - #{l\ 2598}# - #{w*\ 2562}#))) - (#{expand-kw\ 2534}# - #{req\ 2555}# - (if (pair? #{out\ 2563}#) - (reverse #{out\ 2563}#) - #f) - (syntax->datum #{rest\ 2557}#) - (if (pair? #{kw\ 2558}#) - (cdr #{kw\ 2558}#) - #{kw\ 2558}#) - #{body\ 2559}# - (cons #{v\ 2596}# #{vars\ 2560}#) - #{r*\ 2600}# - #{w*\ 2602}# - (if (pair? #{kw\ 2558}#) - (car #{kw\ 2558}#) - #f) - '() - #{inits\ 2564}#))))))))) - (#{expand-kw\ 2534}# - #{req\ 2555}# - (if (pair? #{out\ 2563}#) - (reverse #{out\ 2563}#) - #f) - #f - (if (pair? #{kw\ 2558}#) - (cdr #{kw\ 2558}#) - #{kw\ 2558}#) - #{body\ 2559}# - #{vars\ 2560}# - #{r*\ 2561}# - #{w*\ 2562}# - (if (pair? #{kw\ 2558}#) (car #{kw\ 2558}#) #f) - '() - #{inits\ 2564}#))))) - (#{expand-kw\ 2534}# - (lambda (#{req\ 2604}# - #{opt\ 2605}# - #{rest\ 2606}# - #{kw\ 2607}# - #{body\ 2608}# - #{vars\ 2609}# - #{r*\ 2610}# - #{w*\ 2611}# - #{aok\ 2612}# - #{out\ 2613}# - #{inits\ 2614}#) - (if (pair? #{kw\ 2607}#) - (let ((#{tmp\ 2628}# (car #{kw\ 2607}#))) - (let ((#{tmp\ 2629}# - ($sc-dispatch #{tmp\ 2628}# '(any any any)))) - (if #{tmp\ 2629}# - (@apply - (lambda (#{k\ 2633}# #{id\ 2634}# #{i\ 2635}#) - (begin - (let ((#{v\ 2638}# - (#{gen-var\ 488}# #{id\ 2634}#))) - (begin - (let ((#{l\ 2640}# - (#{gen-labels\ 395}# - (list #{v\ 2638}#)))) - (begin - (let ((#{r**\ 2642}# - (#{extend-var-env\ 370}# - #{l\ 2640}# - (list #{v\ 2638}#) - #{r*\ 2610}#))) - (begin - (let ((#{w**\ 2644}# - (#{make-binding-wrap\ 424}# - (list #{id\ 2634}#) - #{l\ 2640}# - #{w*\ 2611}#))) - (#{expand-kw\ 2534}# - #{req\ 2604}# - #{opt\ 2605}# - #{rest\ 2606}# - (cdr #{kw\ 2607}#) - #{body\ 2608}# - (cons #{v\ 2638}# - #{vars\ 2609}#) - #{r**\ 2642}# - #{w**\ 2644}# - #{aok\ 2612}# - (cons (list (syntax->datum - #{k\ 2633}#) - (syntax->datum - #{id\ 2634}#) - #{v\ 2638}#) - #{out\ 2613}#) - (cons (#{chi\ 460}# - #{i\ 2635}# - #{r*\ 2610}# - #{w*\ 2611}# - #{mod\ 2519}#) - #{inits\ 2614}#))))))))))) - #{tmp\ 2629}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 2628}#)))) - (#{expand-body\ 2536}# - #{req\ 2604}# - #{opt\ 2605}# - #{rest\ 2606}# - (if (begin - (let ((#{t\ 2648}# #{aok\ 2612}#)) - (if #{t\ 2648}# - #{t\ 2648}# - (pair? #{out\ 2613}#)))) - (cons #{aok\ 2612}# (reverse #{out\ 2613}#)) - #f) - #{body\ 2608}# - (reverse #{vars\ 2609}#) - #{r*\ 2610}# - #{w*\ 2611}# - (reverse #{inits\ 2614}#) - '())))) - (#{expand-body\ 2536}# - (lambda (#{req\ 2650}# - #{opt\ 2651}# - #{rest\ 2652}# - #{kw\ 2653}# - #{body\ 2654}# - #{vars\ 2655}# - #{r*\ 2656}# - #{w*\ 2657}# - #{inits\ 2658}# - #{meta\ 2659}#) - (let ((#{tmp\ 2670}# #{body\ 2654}#)) - (let ((#{tmp\ 2671}# - ($sc-dispatch - #{tmp\ 2670}# - '(any any . each-any)))) - (if (if #{tmp\ 2671}# - (@apply - (lambda (#{docstring\ 2675}# - #{e1\ 2676}# - #{e2\ 2677}#) - (string? - (syntax->datum #{docstring\ 2675}#))) - #{tmp\ 2671}#) - #f) - (@apply - (lambda (#{docstring\ 2681}# - #{e1\ 2682}# - #{e2\ 2683}#) - (#{expand-body\ 2536}# - #{req\ 2650}# - #{opt\ 2651}# - #{rest\ 2652}# - #{kw\ 2653}# - (cons #{e1\ 2682}# #{e2\ 2683}#) - #{vars\ 2655}# - #{r*\ 2656}# - #{w*\ 2657}# - #{inits\ 2658}# - (append - #{meta\ 2659}# - (list (cons 'documentation - (syntax->datum - #{docstring\ 2681}#)))))) - #{tmp\ 2671}#) - (let ((#{tmp\ 2686}# - ($sc-dispatch - #{tmp\ 2670}# - '(#(vector #(each (any . any))) - any - . - each-any)))) - (if #{tmp\ 2686}# - (@apply - (lambda (#{k\ 2691}# - #{v\ 2692}# - #{e1\ 2693}# - #{e2\ 2694}#) - (#{expand-body\ 2536}# - #{req\ 2650}# - #{opt\ 2651}# - #{rest\ 2652}# - #{kw\ 2653}# - (cons #{e1\ 2693}# #{e2\ 2694}#) - #{vars\ 2655}# - #{r*\ 2656}# - #{w*\ 2657}# - #{inits\ 2658}# - (append - #{meta\ 2659}# - (syntax->datum - (map cons #{k\ 2691}# #{v\ 2692}#))))) - #{tmp\ 2686}#) - (let ((#{tmp\ 2698}# - ($sc-dispatch - #{tmp\ 2670}# - '(any . each-any)))) - (if #{tmp\ 2698}# - (@apply - (lambda (#{e1\ 2701}# #{e2\ 2702}#) - (values - #{meta\ 2659}# - #{req\ 2650}# - #{opt\ 2651}# - #{rest\ 2652}# - #{kw\ 2653}# - #{inits\ 2658}# - #{vars\ 2655}# - (#{chi-body\ 468}# - (cons #{e1\ 2701}# #{e2\ 2702}#) - (#{source-wrap\ 448}# - #{e\ 2515}# - #{w\ 2517}# - #{s\ 2518}# - #{mod\ 2519}#) - #{r*\ 2656}# - #{w*\ 2657}# - #{mod\ 2519}#))) - #{tmp\ 2698}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 2670}#))))))))))) - (begin - (let ((#{tmp\ 2704}# #{clauses\ 2521}#)) - (let ((#{tmp\ 2705}# ($sc-dispatch #{tmp\ 2704}# '()))) - (if #{tmp\ 2705}# - (@apply - (lambda () (values '() #f)) - #{tmp\ 2705}#) - (let ((#{tmp\ 2706}# - ($sc-dispatch - #{tmp\ 2704}# - '((any any . each-any) - . - #(each (any any . each-any)))))) - (if #{tmp\ 2706}# - (@apply - (lambda (#{args\ 2713}# - #{e1\ 2714}# - #{e2\ 2715}# - #{args*\ 2716}# - #{e1*\ 2717}# - #{e2*\ 2718}#) - (call-with-values - (lambda () - (#{get-formals\ 2520}# #{args\ 2713}#)) - (lambda (#{req\ 2719}# - #{opt\ 2720}# - #{rest\ 2721}# - #{kw\ 2722}#) - (call-with-values - (lambda () - (#{expand-req\ 2530}# - #{req\ 2719}# - #{opt\ 2720}# - #{rest\ 2721}# - #{kw\ 2722}# - (cons #{e1\ 2714}# #{e2\ 2715}#))) - (lambda (#{meta\ 2728}# - #{req\ 2729}# - #{opt\ 2730}# - #{rest\ 2731}# - #{kw\ 2732}# - #{inits\ 2733}# - #{vars\ 2734}# - #{body\ 2735}#) - (call-with-values - (lambda () - (#{chi-lambda-case\ 484}# - #{e\ 2515}# - #{r\ 2516}# - #{w\ 2517}# - #{s\ 2518}# - #{mod\ 2519}# - #{get-formals\ 2520}# - (map (lambda (#{tmp\ 2746}# - #{tmp\ 2745}# - #{tmp\ 2744}#) - (cons #{tmp\ 2744}# - (cons #{tmp\ 2745}# - #{tmp\ 2746}#))) - #{e2*\ 2718}# - #{e1*\ 2717}# - #{args*\ 2716}#))) - (lambda (#{meta*\ 2748}# - #{else*\ 2749}#) - (values - (append - #{meta\ 2728}# - #{meta*\ 2748}#) - (#{build-lambda-case\ 328}# - #{s\ 2518}# - #{req\ 2729}# - #{opt\ 2730}# - #{rest\ 2731}# - #{kw\ 2732}# - #{inits\ 2733}# - #{vars\ 2734}# - #{body\ 2735}# - #{else*\ 2749}#))))))))) - #{tmp\ 2706}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 2704}#)))))))))) - (#{strip\ 486}# - (lambda (#{x\ 2752}# #{w\ 2753}#) - (if (memq 'top (car #{w\ 2753}#)) - #{x\ 2752}# - (letrec* - ((#{f\ 2760}# - (lambda (#{x\ 2761}#) - (if (#{syntax-object?\ 346}# #{x\ 2761}#) - (#{strip\ 486}# - (#{syntax-object-expression\ 348}# #{x\ 2761}#) - (#{syntax-object-wrap\ 350}# #{x\ 2761}#)) - (if (pair? #{x\ 2761}#) - (begin - (let ((#{a\ 2768}# (#{f\ 2760}# (car #{x\ 2761}#))) - (#{d\ 2769}# - (#{f\ 2760}# (cdr #{x\ 2761}#)))) - (if (if (eq? #{a\ 2768}# (car #{x\ 2761}#)) - (eq? #{d\ 2769}# (cdr #{x\ 2761}#)) - #f) - #{x\ 2761}# - (cons #{a\ 2768}# #{d\ 2769}#)))) - (if (vector? #{x\ 2761}#) - (begin - (let ((#{old\ 2775}# (vector->list #{x\ 2761}#))) - (begin - (let ((#{new\ 2777}# - (map #{f\ 2760}# #{old\ 2775}#))) - (if (#{and-map*\ 38}# - eq? - #{old\ 2775}# - #{new\ 2777}#) - #{x\ 2761}# - (list->vector #{new\ 2777}#)))))) - #{x\ 2761}#)))))) - (begin (#{f\ 2760}# #{x\ 2752}#)))))) - (#{gen-var\ 488}# - (lambda (#{id\ 2779}#) - (begin - (let ((#{id\ 2782}# - (if (#{syntax-object?\ 346}# #{id\ 2779}#) - (#{syntax-object-expression\ 348}# #{id\ 2779}#) - #{id\ 2779}#))) - (gensym - (string-append (symbol->string #{id\ 2782}#) " ")))))) - (#{lambda-var-list\ 490}# - (lambda (#{vars\ 2784}#) - (letrec* - ((#{lvl\ 2790}# - (lambda (#{vars\ 2791}# #{ls\ 2792}# #{w\ 2793}#) - (if (pair? #{vars\ 2791}#) - (#{lvl\ 2790}# - (cdr #{vars\ 2791}#) - (cons (#{wrap\ 446}# - (car #{vars\ 2791}#) - #{w\ 2793}# - #f) - #{ls\ 2792}#) - #{w\ 2793}#) - (if (#{id?\ 380}# #{vars\ 2791}#) - (cons (#{wrap\ 446}# #{vars\ 2791}# #{w\ 2793}# #f) - #{ls\ 2792}#) - (if (null? #{vars\ 2791}#) - #{ls\ 2792}# - (if (#{syntax-object?\ 346}# #{vars\ 2791}#) - (#{lvl\ 2790}# - (#{syntax-object-expression\ 348}# - #{vars\ 2791}#) - #{ls\ 2792}# - (#{join-wraps\ 428}# - #{w\ 2793}# - (#{syntax-object-wrap\ 350}# #{vars\ 2791}#))) - (cons #{vars\ 2791}# #{ls\ 2792}#)))))))) - (begin (#{lvl\ 2790}# #{vars\ 2784}# '() '(()))))))) - (begin - (lambda (#{src\ 756}# #{name\ 757}#) - (make-struct/no-tail - (vector-ref %expanded-vtables 2) - #{src\ 756}# - #{name\ 757}#)) - (lambda (#{x\ 1134}# #{update\ 1135}#) - (vector-set! #{x\ 1134}# 1 #{update\ 1135}#)) - (lambda (#{x\ 1138}# #{update\ 1139}#) - (vector-set! #{x\ 1138}# 2 #{update\ 1139}#)) - (lambda (#{x\ 1142}# #{update\ 1143}#) - (vector-set! #{x\ 1142}# 3 #{update\ 1143}#)) - (lambda (#{x\ 1223}#) - (if (vector? #{x\ 1223}#) - (if (= (vector-length #{x\ 1223}#) 4) - (eq? (vector-ref #{x\ 1223}# 0) 'ribcage) - #f) - #f)) - (set! #{fx+\ 283}# +) - (set! #{fx-\ 285}# -) - (set! #{fx=\ 287}# =) - (set! #{fx<\ 289}# <) - (begin - (#{global-extend\ 376}# - 'local-syntax - 'letrec-syntax - #t) - (#{global-extend\ 376}# - 'local-syntax - 'let-syntax - #f) - (#{global-extend\ 376}# - 'core - 'fluid-let-syntax - (lambda (#{e\ 2804}# - #{r\ 2805}# - #{w\ 2806}# - #{s\ 2807}# - #{mod\ 2808}#) - (let ((#{tmp\ 2814}# #{e\ 2804}#)) - (let ((#{tmp\ 2815}# - ($sc-dispatch - #{tmp\ 2814}# - '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 2815}# - (@apply - (lambda (#{var\ 2820}# - #{val\ 2821}# - #{e1\ 2822}# - #{e2\ 2823}#) - (#{valid-bound-ids?\ 440}# #{var\ 2820}#)) - #{tmp\ 2815}#) - #f) - (@apply - (lambda (#{var\ 2829}# - #{val\ 2830}# - #{e1\ 2831}# - #{e2\ 2832}#) - (begin - (let ((#{names\ 2834}# - (map (lambda (#{x\ 2835}#) - (#{id-var-name\ 434}# - #{x\ 2835}# - #{w\ 2806}#)) - #{var\ 2829}#))) - (begin - (for-each - (lambda (#{id\ 2838}# #{n\ 2839}#) - (begin - (let ((#{atom-key\ 2844}# - (car (#{lookup\ 374}# - #{n\ 2839}# - #{r\ 2805}# - #{mod\ 2808}#)))) - (if (eqv? #{atom-key\ 2844}# - 'displaced-lexical) - (syntax-violation - 'fluid-let-syntax - "identifier out of context" - #{e\ 2804}# - (#{source-wrap\ 448}# - #{id\ 2838}# - #{w\ 2806}# - #{s\ 2807}# - #{mod\ 2808}#)))))) - #{var\ 2829}# - #{names\ 2834}#) - (#{chi-body\ 468}# - (cons #{e1\ 2831}# #{e2\ 2832}#) - (#{source-wrap\ 448}# - #{e\ 2804}# - #{w\ 2806}# - #{s\ 2807}# - #{mod\ 2808}#) - (#{extend-env\ 368}# - #{names\ 2834}# - (begin - (let ((#{trans-r\ 2850}# - (#{macros-only-env\ 372}# - #{r\ 2805}#))) - (map (lambda (#{x\ 2851}#) - (cons 'macro - (#{eval-local-transformer\ 472}# - (#{chi\ 460}# - #{x\ 2851}# - #{trans-r\ 2850}# - #{w\ 2806}# - #{mod\ 2808}#) - #{mod\ 2808}#))) - #{val\ 2830}#))) - #{r\ 2805}#) - #{w\ 2806}# - #{mod\ 2808}#))))) - #{tmp\ 2815}#) - (let ((#{_\ 2856}# #{tmp\ 2814}#)) - (syntax-violation - 'fluid-let-syntax - "bad syntax" - (#{source-wrap\ 448}# - #{e\ 2804}# - #{w\ 2806}# - #{s\ 2807}# - #{mod\ 2808}#)))))))) - (#{global-extend\ 376}# - 'core - 'quote - (lambda (#{e\ 2857}# - #{r\ 2858}# - #{w\ 2859}# - #{s\ 2860}# - #{mod\ 2861}#) - (let ((#{tmp\ 2867}# #{e\ 2857}#)) - (let ((#{tmp\ 2868}# - ($sc-dispatch #{tmp\ 2867}# '(_ any)))) - (if #{tmp\ 2868}# - (@apply - (lambda (#{e\ 2870}#) - (#{build-data\ 332}# - #{s\ 2860}# - (#{strip\ 486}# #{e\ 2870}# #{w\ 2859}#))) - #{tmp\ 2868}#) - (let ((#{_\ 2872}# #{tmp\ 2867}#)) - (syntax-violation - 'quote - "bad syntax" - (#{source-wrap\ 448}# - #{e\ 2857}# - #{w\ 2859}# - #{s\ 2860}# - #{mod\ 2861}#)))))))) - (#{global-extend\ 376}# - 'core - 'syntax - (letrec* - ((#{gen-syntax\ 2874}# - (lambda (#{src\ 2889}# - #{e\ 2890}# - #{r\ 2891}# - #{maps\ 2892}# - #{ellipsis?\ 2893}# - #{mod\ 2894}#) - (if (#{id?\ 380}# #{e\ 2890}#) - (begin - (let ((#{label\ 2902}# - (#{id-var-name\ 434}# #{e\ 2890}# '(())))) - (begin - (let ((#{b\ 2905}# - (#{lookup\ 374}# - #{label\ 2902}# - #{r\ 2891}# - #{mod\ 2894}#))) - (if (eq? (car #{b\ 2905}#) 'syntax) - (call-with-values - (lambda () + (let ((#{symnamevec\ 1321}# + (make-vector #{n\ 1318}#)) + (#{marksvec\ 1322}# + (make-vector #{n\ 1318}#))) (begin - (let ((#{var.lev\ 2908}# - (cdr #{b\ 2905}#))) - (#{gen-ref\ 2876}# - #{src\ 2889}# - (car #{var.lev\ 2908}#) - (cdr #{var.lev\ 2908}#) - #{maps\ 2892}#)))) - (lambda (#{var\ 2910}# #{maps\ 2911}#) - (values - (list 'ref #{var\ 2910}#) - #{maps\ 2911}#))) - (if (#{ellipsis?\ 2893}# #{e\ 2890}#) - (syntax-violation - 'syntax - "misplaced ellipsis" - #{src\ 2889}#) - (values - (list 'quote #{e\ 2890}#) - #{maps\ 2892}#))))))) - (let ((#{tmp\ 2916}# #{e\ 2890}#)) - (let ((#{tmp\ 2917}# - ($sc-dispatch #{tmp\ 2916}# '(any any)))) - (if (if #{tmp\ 2917}# - (@apply - (lambda (#{dots\ 2920}# #{e\ 2921}#) - (#{ellipsis?\ 2893}# #{dots\ 2920}#)) - #{tmp\ 2917}#) - #f) - (@apply - (lambda (#{dots\ 2924}# #{e\ 2925}#) - (#{gen-syntax\ 2874}# - #{src\ 2889}# - #{e\ 2925}# - #{r\ 2891}# - #{maps\ 2892}# - (lambda (#{x\ 2926}#) #f) - #{mod\ 2894}#)) - #{tmp\ 2917}#) - (let ((#{tmp\ 2928}# - ($sc-dispatch - #{tmp\ 2916}# - '(any any . any)))) - (if (if #{tmp\ 2928}# - (@apply - (lambda (#{x\ 2932}# - #{dots\ 2933}# - #{y\ 2934}#) - (#{ellipsis?\ 2893}# #{dots\ 2933}#)) - #{tmp\ 2928}#) - #f) - (@apply - (lambda (#{x\ 2938}# - #{dots\ 2939}# - #{y\ 2940}#) - (letrec* - ((#{f\ 2944}# - (lambda (#{y\ 2945}# #{k\ 2946}#) - (let ((#{tmp\ 2953}# #{y\ 2945}#)) - (let ((#{tmp\ 2954}# - ($sc-dispatch - #{tmp\ 2953}# - '(any . any)))) - (if (if #{tmp\ 2954}# - (@apply - (lambda (#{dots\ 2957}# - #{y\ 2958}#) - (#{ellipsis?\ 2893}# - #{dots\ 2957}#)) - #{tmp\ 2954}#) - #f) - (@apply - (lambda (#{dots\ 2961}# - #{y\ 2962}#) - (#{f\ 2944}# - #{y\ 2962}# - (lambda (#{maps\ 2963}#) - (call-with-values - (lambda () - (#{k\ 2946}# - (cons '() - #{maps\ 2963}#))) - (lambda (#{x\ 2965}# - #{maps\ 2966}#) - (if (null? (car #{maps\ 2966}#)) - (syntax-violation - 'syntax - "extra ellipsis" - #{src\ 2889}#) - (values - (#{gen-mappend\ 2878}# - #{x\ 2965}# - (car #{maps\ 2966}#)) - (cdr #{maps\ 2966}#)))))))) - #{tmp\ 2954}#) - (let ((#{_\ 2970}# - #{tmp\ 2953}#)) - (call-with-values - (lambda () - (#{gen-syntax\ 2874}# - #{src\ 2889}# - #{y\ 2945}# - #{r\ 2891}# - #{maps\ 2892}# - #{ellipsis?\ 2893}# - #{mod\ 2894}#)) - (lambda (#{y\ 2971}# - #{maps\ 2972}#) - (call-with-values - (lambda () - (#{k\ 2946}# - #{maps\ 2972}#)) - (lambda (#{x\ 2975}# - #{maps\ 2976}#) - (values - (#{gen-append\ 2884}# - #{x\ 2975}# - #{y\ 2971}#) - #{maps\ 2976}#)))))))))))) - (begin - (#{f\ 2944}# - #{y\ 2940}# - (lambda (#{maps\ 2947}#) - (call-with-values - (lambda () - (#{gen-syntax\ 2874}# - #{src\ 2889}# - #{x\ 2938}# - #{r\ 2891}# - (cons '() #{maps\ 2947}#) - #{ellipsis?\ 2893}# - #{mod\ 2894}#)) - (lambda (#{x\ 2949}# - #{maps\ 2950}#) - (if (null? (car #{maps\ 2950}#)) - (syntax-violation - 'syntax - "extra ellipsis" - #{src\ 2889}#) - (values - (#{gen-map\ 2880}# - #{x\ 2949}# - (car #{maps\ 2950}#)) - (cdr #{maps\ 2950}#)))))))))) - #{tmp\ 2928}#) - (let ((#{tmp\ 2979}# - ($sc-dispatch - #{tmp\ 2916}# - '(any . any)))) - (if #{tmp\ 2979}# - (@apply - (lambda (#{x\ 2982}# #{y\ 2983}#) - (call-with-values - (lambda () - (#{gen-syntax\ 2874}# - #{src\ 2889}# - #{x\ 2982}# - #{r\ 2891}# - #{maps\ 2892}# - #{ellipsis?\ 2893}# - #{mod\ 2894}#)) - (lambda (#{x\ 2984}# #{maps\ 2985}#) - (call-with-values - (lambda () - (#{gen-syntax\ 2874}# - #{src\ 2889}# - #{y\ 2983}# - #{r\ 2891}# - #{maps\ 2985}# - #{ellipsis?\ 2893}# - #{mod\ 2894}#)) - (lambda (#{y\ 2988}# - #{maps\ 2989}#) - (values - (#{gen-cons\ 2882}# - #{x\ 2984}# - #{y\ 2988}#) - #{maps\ 2989}#)))))) - #{tmp\ 2979}#) - (let ((#{tmp\ 2992}# - ($sc-dispatch - #{tmp\ 2916}# - '#(vector (any . each-any))))) - (if #{tmp\ 2992}# - (@apply - (lambda (#{e1\ 2995}# #{e2\ 2996}#) - (call-with-values - (lambda () - (#{gen-syntax\ 2874}# - #{src\ 2889}# - (cons #{e1\ 2995}# - #{e2\ 2996}#) - #{r\ 2891}# - #{maps\ 2892}# - #{ellipsis?\ 2893}# - #{mod\ 2894}#)) - (lambda (#{e\ 2998}# - #{maps\ 2999}#) - (values - (#{gen-vector\ 2886}# - #{e\ 2998}#) - #{maps\ 2999}#)))) - #{tmp\ 2992}#) - (let ((#{_\ 3003}# #{tmp\ 2916}#)) - (values - (list 'quote #{e\ 2890}#) - #{maps\ 2892}#)))))))))))))) - (#{gen-ref\ 2876}# - (lambda (#{src\ 3005}# - #{var\ 3006}# - #{level\ 3007}# - #{maps\ 3008}#) - (if (#{fx=\ 287}# #{level\ 3007}# 0) - (values #{var\ 3006}# #{maps\ 3008}#) - (if (null? #{maps\ 3008}#) - (syntax-violation - 'syntax - "missing ellipsis" - #{src\ 3005}#) - (call-with-values - (lambda () - (#{gen-ref\ 2876}# - #{src\ 3005}# - #{var\ 3006}# - (#{fx-\ 285}# #{level\ 3007}# 1) - (cdr #{maps\ 3008}#))) - (lambda (#{outer-var\ 3013}# #{outer-maps\ 3014}#) - (begin - (let ((#{b\ 3018}# - (assq #{outer-var\ 3013}# - (car #{maps\ 3008}#)))) - (if #{b\ 3018}# - (values (cdr #{b\ 3018}#) #{maps\ 3008}#) - (begin - (let ((#{inner-var\ 3020}# - (#{gen-var\ 488}# 'tmp))) - (values - #{inner-var\ 3020}# - (cons (cons (cons #{outer-var\ 3013}# - #{inner-var\ 3020}#) - (car #{maps\ 3008}#)) - #{outer-maps\ 3014}#))))))))))))) - (#{gen-mappend\ 2878}# - (lambda (#{e\ 3021}# #{map-env\ 3022}#) - (list 'apply - '(primitive append) - (#{gen-map\ 2880}# #{e\ 3021}# #{map-env\ 3022}#)))) - (#{gen-map\ 2880}# - (lambda (#{e\ 3026}# #{map-env\ 3027}#) - (begin - (let ((#{formals\ 3032}# (map cdr #{map-env\ 3027}#)) - (#{actuals\ 3033}# - (map (lambda (#{x\ 3034}#) - (list 'ref (car #{x\ 3034}#))) - #{map-env\ 3027}#))) - (if (eq? (car #{e\ 3026}#) 'ref) - (car #{actuals\ 3033}#) - (if (and-map - (lambda (#{x\ 3041}#) - (if (eq? (car #{x\ 3041}#) 'ref) - (memq (car (cdr #{x\ 3041}#)) - #{formals\ 3032}#) - #f)) - (cdr #{e\ 3026}#)) - (cons 'map - (cons (list 'primitive (car #{e\ 3026}#)) - (map (begin - (let ((#{r\ 3047}# - (map cons - #{formals\ 3032}# - #{actuals\ 3033}#))) - (lambda (#{x\ 3048}#) - (cdr (assq (car (cdr #{x\ 3048}#)) - #{r\ 3047}#))))) - (cdr #{e\ 3026}#)))) - (cons 'map - (cons (list 'lambda - #{formals\ 3032}# - #{e\ 3026}#) - #{actuals\ 3033}#)))))))) - (#{gen-cons\ 2882}# - (lambda (#{x\ 3052}# #{y\ 3053}#) - (begin - (let ((#{atom-key\ 3058}# (car #{y\ 3053}#))) - (if (eqv? #{atom-key\ 3058}# 'quote) - (if (eq? (car #{x\ 3052}#) 'quote) - (list 'quote - (cons (car (cdr #{x\ 3052}#)) - (car (cdr #{y\ 3053}#)))) - (if (eq? (car (cdr #{y\ 3053}#)) '()) - (list 'list #{x\ 3052}#) - (list 'cons #{x\ 3052}# #{y\ 3053}#))) - (if (eqv? #{atom-key\ 3058}# 'list) - (cons 'list (cons #{x\ 3052}# (cdr #{y\ 3053}#))) - (list 'cons #{x\ 3052}# #{y\ 3053}#))))))) - (#{gen-append\ 2884}# - (lambda (#{x\ 3067}# #{y\ 3068}#) - (if (equal? #{y\ 3068}# ''()) - #{x\ 3067}# - (list 'append #{x\ 3067}# #{y\ 3068}#)))) - (#{gen-vector\ 2886}# - (lambda (#{x\ 3072}#) - (if (eq? (car #{x\ 3072}#) 'list) - (cons 'vector (cdr #{x\ 3072}#)) - (if (eq? (car #{x\ 3072}#) 'quote) - (list 'quote - (list->vector (car (cdr #{x\ 3072}#)))) - (list 'list->vector #{x\ 3072}#))))) - (#{regen\ 2888}# - (lambda (#{x\ 3082}#) - (begin - (let ((#{atom-key\ 3086}# (car #{x\ 3082}#))) - (if (eqv? #{atom-key\ 3086}# 'ref) - (#{build-lexical-reference\ 312}# - 'value - #f - (car (cdr #{x\ 3082}#)) - (car (cdr #{x\ 3082}#))) - (if (eqv? #{atom-key\ 3086}# 'primitive) - (#{build-primref\ 330}# - #f - (car (cdr #{x\ 3082}#))) - (if (eqv? #{atom-key\ 3086}# 'quote) - (#{build-data\ 332}# #f (car (cdr #{x\ 3082}#))) - (if (eqv? #{atom-key\ 3086}# 'lambda) - (if (list? (car (cdr #{x\ 3082}#))) - (#{build-simple-lambda\ 324}# - #f - (car (cdr #{x\ 3082}#)) - #f - (car (cdr #{x\ 3082}#)) - '() - (#{regen\ 2888}# - (car (cdr (cdr #{x\ 3082}#))))) - (error "how did we get here" #{x\ 3082}#)) - (#{build-application\ 306}# - #f - (#{build-primref\ 330}# - #f - (car #{x\ 3082}#)) - (map #{regen\ 2888}# - (cdr #{x\ 3082}#)))))))))))) - (begin - (lambda (#{e\ 3098}# - #{r\ 3099}# - #{w\ 3100}# - #{s\ 3101}# - #{mod\ 3102}#) + (letrec* + ((#{f\ 1326}# + (lambda (#{ids\ 1327}# #{i\ 1328}#) + (if (not (null? #{ids\ 1327}#)) + (call-with-values + (lambda () + (#{id-sym-name&marks\ 379}# + (car #{ids\ 1327}#) + #{w\ 1309}#)) + (lambda (#{symname\ 1329}# + #{marks\ 1330}#) + (begin + (vector-set! + #{symnamevec\ 1321}# + #{i\ 1328}# + #{symname\ 1329}#) + (vector-set! + #{marksvec\ 1322}# + #{i\ 1328}# + #{marks\ 1330}#) + (#{f\ 1326}# + (cdr #{ids\ 1327}#) + (1+ #{i\ 1328}#))))))))) + (begin (#{f\ 1326}# #{ids\ 1307}# 0))) + (#{make-ribcage\ 394}# + #{symnamevec\ 1321}# + #{marksvec\ 1322}# + #{labelvec\ 1316}#)))))))) + (cdr #{w\ 1309}#)))))) + (#{smart-append\ 422}# + (lambda (#{m1\ 1335}# #{m2\ 1336}#) + (if (null? #{m2\ 1336}#) + #{m1\ 1335}# + (append #{m1\ 1335}# #{m2\ 1336}#)))) + (#{join-wraps\ 424}# + (lambda (#{w1\ 1339}# #{w2\ 1340}#) + (begin + (let ((#{m1\ 1345}# (car #{w1\ 1339}#)) + (#{s1\ 1346}# (cdr #{w1\ 1339}#))) + (if (null? #{m1\ 1345}#) + (if (null? #{s1\ 1346}#) + #{w2\ 1340}# + (cons (car #{w2\ 1340}#) + (#{smart-append\ 422}# + #{s1\ 1346}# + (cdr #{w2\ 1340}#)))) + (cons (#{smart-append\ 422}# + #{m1\ 1345}# + (car #{w2\ 1340}#)) + (#{smart-append\ 422}# + #{s1\ 1346}# + (cdr #{w2\ 1340}#)))))))) + (#{join-marks\ 426}# + (lambda (#{m1\ 1355}# #{m2\ 1356}#) + (#{smart-append\ 422}# #{m1\ 1355}# #{m2\ 1356}#))) + (#{same-marks?\ 428}# + (lambda (#{x\ 1359}# #{y\ 1360}#) + (begin + (let ((#{t\ 1365}# (eq? #{x\ 1359}# #{y\ 1360}#))) + (if #{t\ 1365}# + #{t\ 1365}# + (if (not (null? #{x\ 1359}#)) + (if (not (null? #{y\ 1360}#)) + (if (eq? (car #{x\ 1359}#) (car #{y\ 1360}#)) + (#{same-marks?\ 428}# + (cdr #{x\ 1359}#) + (cdr #{y\ 1360}#)) + #f) + #f) + #f)))))) + (#{id-var-name\ 430}# + (lambda (#{id\ 1371}# #{w\ 1372}#) + (letrec* + ((#{search\ 1377}# + (lambda (#{sym\ 1393}# #{subst\ 1394}# #{marks\ 1395}#) + (if (null? #{subst\ 1394}#) + (values #f #{marks\ 1395}#) (begin - (let ((#{e\ 3109}# - (#{source-wrap\ 448}# - #{e\ 3098}# - #{w\ 3100}# - #{s\ 3101}# - #{mod\ 3102}#))) - (let ((#{tmp\ 3110}# #{e\ 3109}#)) - (let ((#{tmp\ 3111}# - ($sc-dispatch #{tmp\ 3110}# '(_ any)))) - (if #{tmp\ 3111}# - (@apply - (lambda (#{x\ 3113}#) - (call-with-values - (lambda () - (#{gen-syntax\ 2874}# - #{e\ 3109}# - #{x\ 3113}# - #{r\ 3099}# - '() - #{ellipsis?\ 476}# - #{mod\ 3102}#)) - (lambda (#{e\ 3114}# #{maps\ 3115}#) - (#{regen\ 2888}# #{e\ 3114}#)))) - #{tmp\ 3111}#) - (let ((#{_\ 3119}# #{tmp\ 3110}#)) - (syntax-violation - 'syntax - "bad `syntax' form" - #{e\ 3109}#))))))))))) - (#{global-extend\ 376}# - 'core - 'lambda - (lambda (#{e\ 3120}# - #{r\ 3121}# - #{w\ 3122}# - #{s\ 3123}# - #{mod\ 3124}#) - (let ((#{tmp\ 3130}# #{e\ 3120}#)) - (let ((#{tmp\ 3131}# - ($sc-dispatch - #{tmp\ 3130}# - '(_ any any . each-any)))) - (if #{tmp\ 3131}# - (@apply - (lambda (#{args\ 3135}# #{e1\ 3136}# #{e2\ 3137}#) - (call-with-values - (lambda () - (#{lambda-formals\ 478}# #{args\ 3135}#)) - (lambda (#{req\ 3138}# - #{opt\ 3139}# - #{rest\ 3140}# - #{kw\ 3141}#) - (letrec* - ((#{lp\ 3149}# - (lambda (#{body\ 3150}# #{meta\ 3151}#) - (let ((#{tmp\ 3153}# #{body\ 3150}#)) - (let ((#{tmp\ 3154}# - ($sc-dispatch - #{tmp\ 3153}# - '(any any . each-any)))) - (if (if #{tmp\ 3154}# - (@apply - (lambda (#{docstring\ 3158}# - #{e1\ 3159}# - #{e2\ 3160}#) - (string? - (syntax->datum - #{docstring\ 3158}#))) - #{tmp\ 3154}#) - #f) - (@apply - (lambda (#{docstring\ 3164}# - #{e1\ 3165}# - #{e2\ 3166}#) - (#{lp\ 3149}# - (cons #{e1\ 3165}# - #{e2\ 3166}#) - (append - #{meta\ 3151}# - (list (cons 'documentation - (syntax->datum - #{docstring\ 3164}#)))))) - #{tmp\ 3154}#) - (let ((#{tmp\ 3169}# - ($sc-dispatch - #{tmp\ 3153}# - '(#(vector - #(each (any . any))) - any - . - each-any)))) - (if #{tmp\ 3169}# - (@apply - (lambda (#{k\ 3174}# - #{v\ 3175}# - #{e1\ 3176}# - #{e2\ 3177}#) - (#{lp\ 3149}# - (cons #{e1\ 3176}# - #{e2\ 3177}#) - (append - #{meta\ 3151}# - (syntax->datum - (map cons - #{k\ 3174}# - #{v\ 3175}#))))) - #{tmp\ 3169}#) - (let ((#{_\ 3182}# - #{tmp\ 3153}#)) - (#{chi-simple-lambda\ 480}# - #{e\ 3120}# - #{r\ 3121}# - #{w\ 3122}# - #{s\ 3123}# - #{mod\ 3124}# - #{req\ 3138}# - #{rest\ 3140}# - #{meta\ 3151}# - #{body\ 3150}#)))))))))) - (begin - (#{lp\ 3149}# - (cons #{e1\ 3136}# #{e2\ 3137}#) - '())))))) - #{tmp\ 3131}#) - (let ((#{_\ 3184}# #{tmp\ 3130}#)) - (syntax-violation - 'lambda - "bad lambda" - #{e\ 3120}#))))))) - (#{global-extend\ 376}# - 'core - 'lambda* - (lambda (#{e\ 3185}# - #{r\ 3186}# - #{w\ 3187}# - #{s\ 3188}# - #{mod\ 3189}#) - (let ((#{tmp\ 3195}# #{e\ 3185}#)) - (let ((#{tmp\ 3196}# - ($sc-dispatch - #{tmp\ 3195}# - '(_ any any . each-any)))) - (if #{tmp\ 3196}# - (@apply - (lambda (#{args\ 3200}# #{e1\ 3201}# #{e2\ 3202}#) - (call-with-values - (lambda () - (#{chi-lambda-case\ 484}# - #{e\ 3185}# - #{r\ 3186}# - #{w\ 3187}# - #{s\ 3188}# - #{mod\ 3189}# - #{lambda*-formals\ 482}# - (list (cons #{args\ 3200}# - (cons #{e1\ 3201}# - #{e2\ 3202}#))))) - (lambda (#{meta\ 3204}# #{lcase\ 3205}#) - (#{build-case-lambda\ 326}# - #{s\ 3188}# - #{meta\ 3204}# - #{lcase\ 3205}#)))) - #{tmp\ 3196}#) - (let ((#{_\ 3209}# #{tmp\ 3195}#)) - (syntax-violation - 'lambda - "bad lambda*" - #{e\ 3185}#))))))) - (#{global-extend\ 376}# - 'core - 'case-lambda - (lambda (#{e\ 3210}# - #{r\ 3211}# - #{w\ 3212}# - #{s\ 3213}# - #{mod\ 3214}#) - (let ((#{tmp\ 3220}# #{e\ 3210}#)) - (let ((#{tmp\ 3221}# - ($sc-dispatch - #{tmp\ 3220}# - '(_ (any any . each-any) - . - #(each (any any . each-any)))))) - (if #{tmp\ 3221}# - (@apply - (lambda (#{args\ 3228}# - #{e1\ 3229}# - #{e2\ 3230}# - #{args*\ 3231}# - #{e1*\ 3232}# - #{e2*\ 3233}#) - (call-with-values - (lambda () - (#{chi-lambda-case\ 484}# - #{e\ 3210}# - #{r\ 3211}# - #{w\ 3212}# - #{s\ 3213}# - #{mod\ 3214}# - #{lambda-formals\ 478}# - (cons (cons #{args\ 3228}# - (cons #{e1\ 3229}# #{e2\ 3230}#)) - (map (lambda (#{tmp\ 3237}# - #{tmp\ 3236}# - #{tmp\ 3235}#) - (cons #{tmp\ 3235}# - (cons #{tmp\ 3236}# - #{tmp\ 3237}#))) - #{e2*\ 3233}# - #{e1*\ 3232}# - #{args*\ 3231}#)))) - (lambda (#{meta\ 3239}# #{lcase\ 3240}#) - (#{build-case-lambda\ 326}# - #{s\ 3213}# - #{meta\ 3239}# - #{lcase\ 3240}#)))) - #{tmp\ 3221}#) - (let ((#{_\ 3244}# #{tmp\ 3220}#)) - (syntax-violation - 'case-lambda - "bad case-lambda" - #{e\ 3210}#))))))) - (#{global-extend\ 376}# - 'core - 'case-lambda* - (lambda (#{e\ 3245}# - #{r\ 3246}# - #{w\ 3247}# - #{s\ 3248}# - #{mod\ 3249}#) - (let ((#{tmp\ 3255}# #{e\ 3245}#)) - (let ((#{tmp\ 3256}# - ($sc-dispatch - #{tmp\ 3255}# - '(_ (any any . each-any) - . - #(each (any any . each-any)))))) - (if #{tmp\ 3256}# - (@apply - (lambda (#{args\ 3263}# - #{e1\ 3264}# - #{e2\ 3265}# - #{args*\ 3266}# - #{e1*\ 3267}# - #{e2*\ 3268}#) - (call-with-values - (lambda () - (#{chi-lambda-case\ 484}# - #{e\ 3245}# - #{r\ 3246}# - #{w\ 3247}# - #{s\ 3248}# - #{mod\ 3249}# - #{lambda*-formals\ 482}# - (cons (cons #{args\ 3263}# - (cons #{e1\ 3264}# #{e2\ 3265}#)) - (map (lambda (#{tmp\ 3272}# - #{tmp\ 3271}# - #{tmp\ 3270}#) - (cons #{tmp\ 3270}# - (cons #{tmp\ 3271}# - #{tmp\ 3272}#))) - #{e2*\ 3268}# - #{e1*\ 3267}# - #{args*\ 3266}#)))) - (lambda (#{meta\ 3274}# #{lcase\ 3275}#) - (#{build-case-lambda\ 326}# - #{s\ 3248}# - #{meta\ 3274}# - #{lcase\ 3275}#)))) - #{tmp\ 3256}#) - (let ((#{_\ 3279}# #{tmp\ 3255}#)) - (syntax-violation - 'case-lambda - "bad case-lambda*" - #{e\ 3245}#))))))) - (#{global-extend\ 376}# - 'core - 'let - (letrec* - ((#{chi-let\ 3281}# - (lambda (#{e\ 3282}# - #{r\ 3283}# - #{w\ 3284}# - #{s\ 3285}# - #{mod\ 3286}# - #{constructor\ 3287}# - #{ids\ 3288}# - #{vals\ 3289}# - #{exps\ 3290}#) - (if (not (#{valid-bound-ids?\ 440}# #{ids\ 3288}#)) - (syntax-violation - 'let - "duplicate bound variable" - #{e\ 3282}#) + (let ((#{fst\ 1400}# (car #{subst\ 1394}#))) + (if (eq? #{fst\ 1400}# 'shift) + (#{search\ 1377}# + #{sym\ 1393}# + (cdr #{subst\ 1394}#) + (cdr #{marks\ 1395}#)) + (begin + (let ((#{symnames\ 1402}# + (#{ribcage-symnames\ 398}# #{fst\ 1400}#))) + (if (vector? #{symnames\ 1402}#) + (#{search-vector-rib\ 1381}# + #{sym\ 1393}# + #{subst\ 1394}# + #{marks\ 1395}# + #{symnames\ 1402}# + #{fst\ 1400}#) + (#{search-list-rib\ 1379}# + #{sym\ 1393}# + #{subst\ 1394}# + #{marks\ 1395}# + #{symnames\ 1402}# + #{fst\ 1400}#)))))))))) + (#{search-list-rib\ 1379}# + (lambda (#{sym\ 1403}# + #{subst\ 1404}# + #{marks\ 1405}# + #{symnames\ 1406}# + #{ribcage\ 1407}#) + (letrec* + ((#{f\ 1416}# + (lambda (#{symnames\ 1417}# #{i\ 1418}#) + (if (null? #{symnames\ 1417}#) + (#{search\ 1377}# + #{sym\ 1403}# + (cdr #{subst\ 1404}#) + #{marks\ 1405}#) + (if (if (eq? (car #{symnames\ 1417}#) #{sym\ 1403}#) + (#{same-marks?\ 428}# + #{marks\ 1405}# + (list-ref + (#{ribcage-marks\ 400}# #{ribcage\ 1407}#) + #{i\ 1418}#)) + #f) + (values + (list-ref + (#{ribcage-labels\ 402}# #{ribcage\ 1407}#) + #{i\ 1418}#) + #{marks\ 1405}#) + (#{f\ 1416}# + (cdr #{symnames\ 1417}#) + (1+ #{i\ 1418}#))))))) + (begin (#{f\ 1416}# #{symnames\ 1406}# 0))))) + (#{search-vector-rib\ 1381}# + (lambda (#{sym\ 1427}# + #{subst\ 1428}# + #{marks\ 1429}# + #{symnames\ 1430}# + #{ribcage\ 1431}#) + (begin + (let ((#{n\ 1438}# (vector-length #{symnames\ 1430}#))) + (letrec* + ((#{f\ 1441}# + (lambda (#{i\ 1442}#) + (if (= #{i\ 1442}# #{n\ 1438}#) + (#{search\ 1377}# + #{sym\ 1427}# + (cdr #{subst\ 1428}#) + #{marks\ 1429}#) + (if (if (eq? (vector-ref + #{symnames\ 1430}# + #{i\ 1442}#) + #{sym\ 1427}#) + (#{same-marks?\ 428}# + #{marks\ 1429}# + (vector-ref + (#{ribcage-marks\ 400}# + #{ribcage\ 1431}#) + #{i\ 1442}#)) + #f) + (values + (vector-ref + (#{ribcage-labels\ 402}# + #{ribcage\ 1431}#) + #{i\ 1442}#) + #{marks\ 1429}#) + (#{f\ 1441}# (1+ #{i\ 1442}#))))))) + (begin (#{f\ 1441}# 0)))))))) + (begin + (if (symbol? #{id\ 1371}#) + (begin + (let ((#{t\ 1454}# + (call-with-values + (lambda () + (#{search\ 1377}# + #{id\ 1371}# + (cdr #{w\ 1372}#) + (car #{w\ 1372}#))) + (lambda (#{x\ 1458}# . #{ignore\ 1459}#) + #{x\ 1458}#)))) + (if #{t\ 1454}# #{t\ 1454}# #{id\ 1371}#))) + (if (#{syntax-object?\ 342}# #{id\ 1371}#) + (begin + (let ((#{id\ 1467}# + (#{syntax-object-expression\ 344}# #{id\ 1371}#)) + (#{w1\ 1468}# + (#{syntax-object-wrap\ 346}# #{id\ 1371}#))) (begin - (let ((#{labels\ 3302}# - (#{gen-labels\ 395}# #{ids\ 3288}#)) - (#{new-vars\ 3303}# - (map #{gen-var\ 488}# #{ids\ 3288}#))) - (begin - (let ((#{nw\ 3306}# - (#{make-binding-wrap\ 424}# - #{ids\ 3288}# - #{labels\ 3302}# - #{w\ 3284}#)) - (#{nr\ 3307}# - (#{extend-var-env\ 370}# - #{labels\ 3302}# - #{new-vars\ 3303}# - #{r\ 3283}#))) - (#{constructor\ 3287}# - #{s\ 3285}# - (map syntax->datum #{ids\ 3288}#) - #{new-vars\ 3303}# - (map (lambda (#{x\ 3308}#) - (#{chi\ 460}# - #{x\ 3308}# - #{r\ 3283}# - #{w\ 3284}# - #{mod\ 3286}#)) - #{vals\ 3289}#) - (#{chi-body\ 468}# - #{exps\ 3290}# - (#{source-wrap\ 448}# - #{e\ 3282}# - #{nw\ 3306}# - #{s\ 3285}# - #{mod\ 3286}#) - #{nr\ 3307}# - #{nw\ 3306}# - #{mod\ 3286}#)))))))))) - (begin - (lambda (#{e\ 3310}# - #{r\ 3311}# - #{w\ 3312}# - #{s\ 3313}# - #{mod\ 3314}#) - (let ((#{tmp\ 3320}# #{e\ 3310}#)) - (let ((#{tmp\ 3321}# - ($sc-dispatch - #{tmp\ 3320}# - '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3321}# - (@apply - (lambda (#{id\ 3326}# - #{val\ 3327}# - #{e1\ 3328}# - #{e2\ 3329}#) - (and-map #{id?\ 380}# #{id\ 3326}#)) - #{tmp\ 3321}#) - #f) - (@apply - (lambda (#{id\ 3335}# - #{val\ 3336}# - #{e1\ 3337}# - #{e2\ 3338}#) - (#{chi-let\ 3281}# - #{e\ 3310}# - #{r\ 3311}# - #{w\ 3312}# - #{s\ 3313}# - #{mod\ 3314}# - #{build-let\ 336}# - #{id\ 3335}# - #{val\ 3336}# - (cons #{e1\ 3337}# #{e2\ 3338}#))) - #{tmp\ 3321}#) - (let ((#{tmp\ 3342}# - ($sc-dispatch - #{tmp\ 3320}# - '(_ any - #(each (any any)) - any - . - each-any)))) - (if (if #{tmp\ 3342}# - (@apply - (lambda (#{f\ 3348}# - #{id\ 3349}# - #{val\ 3350}# - #{e1\ 3351}# - #{e2\ 3352}#) - (if (#{id?\ 380}# #{f\ 3348}#) - (and-map #{id?\ 380}# #{id\ 3349}#) - #f)) - #{tmp\ 3342}#) - #f) - (@apply - (lambda (#{f\ 3361}# - #{id\ 3362}# - #{val\ 3363}# - #{e1\ 3364}# - #{e2\ 3365}#) - (#{chi-let\ 3281}# - #{e\ 3310}# - #{r\ 3311}# - #{w\ 3312}# - #{s\ 3313}# - #{mod\ 3314}# - #{build-named-let\ 338}# - (cons #{f\ 3361}# #{id\ 3362}#) - #{val\ 3363}# - (cons #{e1\ 3364}# #{e2\ 3365}#))) - #{tmp\ 3342}#) - (let ((#{_\ 3370}# #{tmp\ 3320}#)) - (syntax-violation - 'let - "bad let" - (#{source-wrap\ 448}# - #{e\ 3310}# - #{w\ 3312}# - #{s\ 3313}# - #{mod\ 3314}#)))))))))))) - (#{global-extend\ 376}# - 'core - 'letrec - (lambda (#{e\ 3371}# - #{r\ 3372}# - #{w\ 3373}# - #{s\ 3374}# - #{mod\ 3375}#) - (let ((#{tmp\ 3381}# #{e\ 3371}#)) - (let ((#{tmp\ 3382}# - ($sc-dispatch - #{tmp\ 3381}# - '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3382}# - (@apply - (lambda (#{id\ 3387}# - #{val\ 3388}# - #{e1\ 3389}# - #{e2\ 3390}#) - (and-map #{id?\ 380}# #{id\ 3387}#)) - #{tmp\ 3382}#) - #f) - (@apply - (lambda (#{id\ 3396}# - #{val\ 3397}# - #{e1\ 3398}# - #{e2\ 3399}#) - (begin - (let ((#{ids\ 3401}# #{id\ 3396}#)) - (if (not (#{valid-bound-ids?\ 440}# - #{ids\ 3401}#)) - (syntax-violation - 'letrec - "duplicate bound variable" - #{e\ 3371}#) - (begin - (let ((#{labels\ 3405}# - (#{gen-labels\ 395}# #{ids\ 3401}#)) - (#{new-vars\ 3406}# - (map #{gen-var\ 488}# - #{ids\ 3401}#))) - (begin - (let ((#{w\ 3409}# - (#{make-binding-wrap\ 424}# - #{ids\ 3401}# - #{labels\ 3405}# - #{w\ 3373}#)) - (#{r\ 3410}# - (#{extend-var-env\ 370}# - #{labels\ 3405}# - #{new-vars\ 3406}# - #{r\ 3372}#))) - (#{build-letrec\ 340}# - #{s\ 3374}# - #f - (map syntax->datum #{ids\ 3401}#) - #{new-vars\ 3406}# - (map (lambda (#{x\ 3411}#) - (#{chi\ 460}# - #{x\ 3411}# - #{r\ 3410}# - #{w\ 3409}# - #{mod\ 3375}#)) - #{val\ 3397}#) - (#{chi-body\ 468}# - (cons #{e1\ 3398}# #{e2\ 3399}#) - (#{source-wrap\ 448}# - #{e\ 3371}# - #{w\ 3409}# - #{s\ 3374}# - #{mod\ 3375}#) - #{r\ 3410}# - #{w\ 3409}# - #{mod\ 3375}#)))))))))) - #{tmp\ 3382}#) - (let ((#{_\ 3416}# #{tmp\ 3381}#)) - (syntax-violation - 'letrec - "bad letrec" - (#{source-wrap\ 448}# - #{e\ 3371}# - #{w\ 3373}# - #{s\ 3374}# - #{mod\ 3375}#)))))))) - (#{global-extend\ 376}# - 'core - 'letrec* - (lambda (#{e\ 3417}# - #{r\ 3418}# - #{w\ 3419}# - #{s\ 3420}# - #{mod\ 3421}#) - (let ((#{tmp\ 3427}# #{e\ 3417}#)) - (let ((#{tmp\ 3428}# - ($sc-dispatch - #{tmp\ 3427}# - '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3428}# - (@apply - (lambda (#{id\ 3433}# - #{val\ 3434}# - #{e1\ 3435}# - #{e2\ 3436}#) - (and-map #{id?\ 380}# #{id\ 3433}#)) - #{tmp\ 3428}#) - #f) - (@apply - (lambda (#{id\ 3442}# - #{val\ 3443}# - #{e1\ 3444}# - #{e2\ 3445}#) - (begin - (let ((#{ids\ 3447}# #{id\ 3442}#)) - (if (not (#{valid-bound-ids?\ 440}# - #{ids\ 3447}#)) - (syntax-violation - 'letrec* - "duplicate bound variable" - #{e\ 3417}#) - (begin - (let ((#{labels\ 3451}# - (#{gen-labels\ 395}# #{ids\ 3447}#)) - (#{new-vars\ 3452}# - (map #{gen-var\ 488}# - #{ids\ 3447}#))) - (begin - (let ((#{w\ 3455}# - (#{make-binding-wrap\ 424}# - #{ids\ 3447}# - #{labels\ 3451}# - #{w\ 3419}#)) - (#{r\ 3456}# - (#{extend-var-env\ 370}# - #{labels\ 3451}# - #{new-vars\ 3452}# - #{r\ 3418}#))) - (#{build-letrec\ 340}# - #{s\ 3420}# - #t - (map syntax->datum #{ids\ 3447}#) - #{new-vars\ 3452}# - (map (lambda (#{x\ 3457}#) - (#{chi\ 460}# - #{x\ 3457}# - #{r\ 3456}# - #{w\ 3455}# - #{mod\ 3421}#)) - #{val\ 3443}#) - (#{chi-body\ 468}# - (cons #{e1\ 3444}# #{e2\ 3445}#) - (#{source-wrap\ 448}# - #{e\ 3417}# - #{w\ 3455}# - #{s\ 3420}# - #{mod\ 3421}#) - #{r\ 3456}# - #{w\ 3455}# - #{mod\ 3421}#)))))))))) - #{tmp\ 3428}#) - (let ((#{_\ 3462}# #{tmp\ 3427}#)) - (syntax-violation - 'letrec* - "bad letrec*" - (#{source-wrap\ 448}# - #{e\ 3417}# - #{w\ 3419}# - #{s\ 3420}# - #{mod\ 3421}#)))))))) - (#{global-extend\ 376}# - 'core - 'set! - (lambda (#{e\ 3463}# - #{r\ 3464}# - #{w\ 3465}# - #{s\ 3466}# - #{mod\ 3467}#) - (let ((#{tmp\ 3473}# #{e\ 3463}#)) - (let ((#{tmp\ 3474}# - ($sc-dispatch #{tmp\ 3473}# '(_ any any)))) - (if (if #{tmp\ 3474}# - (@apply - (lambda (#{id\ 3477}# #{val\ 3478}#) - (#{id?\ 380}# #{id\ 3477}#)) - #{tmp\ 3474}#) - #f) - (@apply - (lambda (#{id\ 3481}# #{val\ 3482}#) - (begin - (let ((#{n\ 3485}# - (#{id-var-name\ 434}# - #{id\ 3481}# - #{w\ 3465}#)) - (#{id-mod\ 3486}# - (if (#{syntax-object?\ 346}# #{id\ 3481}#) - (#{syntax-object-module\ 352}# - #{id\ 3481}#) - #{mod\ 3467}#))) - (begin - (let ((#{b\ 3488}# - (#{lookup\ 374}# - #{n\ 3485}# - #{r\ 3464}# - #{id-mod\ 3486}#))) + (let ((#{marks\ 1470}# + (#{join-marks\ 426}# + (car #{w\ 1372}#) + (car #{w1\ 1468}#)))) + (call-with-values + (lambda () + (#{search\ 1377}# + #{id\ 1467}# + (cdr #{w\ 1372}#) + #{marks\ 1470}#)) + (lambda (#{new-id\ 1474}# #{marks\ 1475}#) + (begin + (let ((#{t\ 1480}# #{new-id\ 1474}#)) + (if #{t\ 1480}# + #{t\ 1480}# + (begin + (let ((#{t\ 1483}# + (call-with-values + (lambda () + (#{search\ 1377}# + #{id\ 1467}# + (cdr #{w1\ 1468}#) + #{marks\ 1475}#)) + (lambda (#{x\ 1486}# + . + #{ignore\ 1487}#) + #{x\ 1486}#)))) + (if #{t\ 1483}# + #{t\ 1483}# + #{id\ 1467}#)))))))))))) + (syntax-violation + 'id-var-name + "invalid id" + #{id\ 1371}#))))))) + (#{free-id=?\ 432}# + (lambda (#{i\ 1492}# #{j\ 1493}#) + (if (eq? (begin + (let ((#{x\ 1499}# #{i\ 1492}#)) + (if (#{syntax-object?\ 342}# #{x\ 1499}#) + (#{syntax-object-expression\ 344}# #{x\ 1499}#) + #{x\ 1499}#))) + (begin + (let ((#{x\ 1502}# #{j\ 1493}#)) + (if (#{syntax-object?\ 342}# #{x\ 1502}#) + (#{syntax-object-expression\ 344}# #{x\ 1502}#) + #{x\ 1502}#)))) + (eq? (#{id-var-name\ 430}# #{i\ 1492}# '(())) + (#{id-var-name\ 430}# #{j\ 1493}# '(()))) + #f))) + (#{bound-id=?\ 434}# + (lambda (#{i\ 1506}# #{j\ 1507}#) + (if (if (#{syntax-object?\ 342}# #{i\ 1506}#) + (#{syntax-object?\ 342}# #{j\ 1507}#) + #f) + (if (eq? (#{syntax-object-expression\ 344}# #{i\ 1506}#) + (#{syntax-object-expression\ 344}# #{j\ 1507}#)) + (#{same-marks?\ 428}# + (car (#{syntax-object-wrap\ 346}# #{i\ 1506}#)) + (car (#{syntax-object-wrap\ 346}# #{j\ 1507}#))) + #f) + (eq? #{i\ 1506}# #{j\ 1507}#)))) + (#{valid-bound-ids?\ 436}# + (lambda (#{ids\ 1516}#) + (if (letrec* + ((#{all-ids?\ 1521}# + (lambda (#{ids\ 1522}#) + (begin + (let ((#{t\ 1525}# (null? #{ids\ 1522}#))) + (if #{t\ 1525}# + #{t\ 1525}# + (if (#{id?\ 376}# (car #{ids\ 1522}#)) + (#{all-ids?\ 1521}# (cdr #{ids\ 1522}#)) + #f))))))) + (begin (#{all-ids?\ 1521}# #{ids\ 1516}#))) + (#{distinct-bound-ids?\ 438}# #{ids\ 1516}#) + #f))) + (#{distinct-bound-ids?\ 438}# + (lambda (#{ids\ 1530}#) + (letrec* + ((#{distinct?\ 1534}# + (lambda (#{ids\ 1535}#) + (begin + (let ((#{t\ 1538}# (null? #{ids\ 1535}#))) + (if #{t\ 1538}# + #{t\ 1538}# + (if (not (#{bound-id-member?\ 440}# + (car #{ids\ 1535}#) + (cdr #{ids\ 1535}#))) + (#{distinct?\ 1534}# (cdr #{ids\ 1535}#)) + #f))))))) + (begin (#{distinct?\ 1534}# #{ids\ 1530}#))))) + (#{bound-id-member?\ 440}# + (lambda (#{x\ 1542}# #{list\ 1543}#) + (if (not (null? #{list\ 1543}#)) + (begin + (let ((#{t\ 1550}# + (#{bound-id=?\ 434}# + #{x\ 1542}# + (car #{list\ 1543}#)))) + (if #{t\ 1550}# + #{t\ 1550}# + (#{bound-id-member?\ 440}# + #{x\ 1542}# + (cdr #{list\ 1543}#))))) + #f))) + (#{wrap\ 442}# + (lambda (#{x\ 1552}# #{w\ 1553}# #{defmod\ 1554}#) + (if (if (null? (car #{w\ 1553}#)) + (null? (cdr #{w\ 1553}#)) + #f) + #{x\ 1552}# + (if (#{syntax-object?\ 342}# #{x\ 1552}#) + (#{make-syntax-object\ 340}# + (#{syntax-object-expression\ 344}# #{x\ 1552}#) + (#{join-wraps\ 424}# + #{w\ 1553}# + (#{syntax-object-wrap\ 346}# #{x\ 1552}#)) + (#{syntax-object-module\ 348}# #{x\ 1552}#)) + (if (null? #{x\ 1552}#) + #{x\ 1552}# + (#{make-syntax-object\ 340}# + #{x\ 1552}# + #{w\ 1553}# + #{defmod\ 1554}#)))))) + (#{source-wrap\ 444}# + (lambda (#{x\ 1569}# + #{w\ 1570}# + #{s\ 1571}# + #{defmod\ 1572}#) + (#{wrap\ 442}# + (#{decorate-source\ 296}# + #{x\ 1569}# + #{s\ 1571}#) + #{w\ 1570}# + #{defmod\ 1572}#))) + (#{chi-sequence\ 446}# + (lambda (#{body\ 1577}# + #{r\ 1578}# + #{w\ 1579}# + #{s\ 1580}# + #{mod\ 1581}#) + (#{build-sequence\ 330}# + #{s\ 1580}# + (letrec* + ((#{dobody\ 1592}# + (lambda (#{body\ 1593}# + #{r\ 1594}# + #{w\ 1595}# + #{mod\ 1596}#) + (if (null? #{body\ 1593}#) + '() + (begin + (let ((#{first\ 1598}# + (#{chi\ 456}# + (car #{body\ 1593}#) + #{r\ 1594}# + #{w\ 1595}# + #{mod\ 1596}#))) + (cons #{first\ 1598}# + (#{dobody\ 1592}# + (cdr #{body\ 1593}#) + #{r\ 1594}# + #{w\ 1595}# + #{mod\ 1596}#)))))))) + (begin + (#{dobody\ 1592}# + #{body\ 1577}# + #{r\ 1578}# + #{w\ 1579}# + #{mod\ 1581}#)))))) + (#{chi-top-sequence\ 448}# + (lambda (#{body\ 1599}# + #{r\ 1600}# + #{w\ 1601}# + #{s\ 1602}# + #{m\ 1603}# + #{esew\ 1604}# + #{mod\ 1605}#) + (letrec* + ((#{scan\ 1614}# + (lambda (#{body\ 1615}# + #{r\ 1616}# + #{w\ 1617}# + #{s\ 1618}# + #{m\ 1619}# + #{esew\ 1620}# + #{mod\ 1621}# + #{exps\ 1622}#) + (if (null? #{body\ 1615}#) + #{exps\ 1622}# + (call-with-values + (lambda () + (call-with-values + (lambda () + (begin + (let ((#{e\ 1635}# (car #{body\ 1615}#))) + (#{syntax-type\ 454}# + #{e\ 1635}# + #{r\ 1616}# + #{w\ 1617}# (begin - (let ((#{atom-key\ 3491}# - (car #{b\ 3488}#))) - (if (eqv? #{atom-key\ 3491}# 'lexical) - (#{build-lexical-assignment\ 314}# - #{s\ 3466}# - (syntax->datum #{id\ 3481}#) - (cdr #{b\ 3488}#) - (#{chi\ 460}# - #{val\ 3482}# - #{r\ 3464}# - #{w\ 3465}# - #{mod\ 3467}#)) - (if (eqv? #{atom-key\ 3491}# 'global) - (#{build-global-assignment\ 320}# - #{s\ 3466}# - #{n\ 3485}# - (#{chi\ 460}# - #{val\ 3482}# - #{r\ 3464}# - #{w\ 3465}# - #{mod\ 3467}#) - #{id-mod\ 3486}#) - (if (eqv? #{atom-key\ 3491}# 'macro) + (let ((#{t\ 1638}# + (#{source-annotation\ 357}# + #{e\ 1635}#))) + (if #{t\ 1638}# + #{t\ 1638}# + #{s\ 1618}#))) + #f + #{mod\ 1621}# + #f)))) + (lambda (#{type\ 1640}# + #{value\ 1641}# + #{e\ 1642}# + #{w\ 1643}# + #{s\ 1644}# + #{mod\ 1645}#) + (if (eqv? #{type\ 1640}# 'begin-form) + (let ((#{tmp\ 1653}# #{e\ 1642}#)) + (let ((#{tmp\ 1654}# + ($sc-dispatch #{tmp\ 1653}# '(_)))) + (if #{tmp\ 1654}# + (@apply + (lambda () #{exps\ 1622}#) + #{tmp\ 1654}#) + (let ((#{tmp\ 1655}# + ($sc-dispatch + #{tmp\ 1653}# + '(_ any . each-any)))) + (if #{tmp\ 1655}# + (@apply + (lambda (#{e1\ 1658}# #{e2\ 1659}#) + (#{scan\ 1614}# + (cons #{e1\ 1658}# #{e2\ 1659}#) + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + #{m\ 1619}# + #{esew\ 1620}# + #{mod\ 1645}# + #{exps\ 1622}#)) + #{tmp\ 1655}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1653}#)))))) + (if (eqv? #{type\ 1640}# 'local-syntax-form) + (#{chi-local-syntax\ 466}# + #{value\ 1641}# + #{e\ 1642}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + #{mod\ 1645}# + (lambda (#{body\ 1662}# + #{r\ 1663}# + #{w\ 1664}# + #{s\ 1665}# + #{mod\ 1666}#) + (#{scan\ 1614}# + #{body\ 1662}# + #{r\ 1663}# + #{w\ 1664}# + #{s\ 1665}# + #{m\ 1619}# + #{esew\ 1620}# + #{mod\ 1666}# + #{exps\ 1622}#))) + (if (eqv? #{type\ 1640}# 'eval-when-form) + (let ((#{tmp\ 1673}# #{e\ 1642}#)) + (let ((#{tmp\ 1674}# + ($sc-dispatch + #{tmp\ 1673}# + '(_ each-any any . each-any)))) + (if #{tmp\ 1674}# + (@apply + (lambda (#{x\ 1678}# + #{e1\ 1679}# + #{e2\ 1680}#) (begin - (let ((#{p\ 3498}# - (cdr #{b\ 3488}#))) - (if (procedure-property - #{p\ 3498}# - 'variable-transformer) - (#{chi\ 460}# - (#{chi-macro\ 466}# - #{p\ 3498}# - #{e\ 3463}# - #{r\ 3464}# - #{w\ 3465}# - #{s\ 3466}# - #f - #{mod\ 3467}#) - #{r\ 3464}# - '(()) - #{mod\ 3467}#) - (syntax-violation - 'set! - "not a variable transformer" - (#{wrap\ 446}# - #{e\ 3463}# - #{w\ 3465}# - #{mod\ 3467}#) - (#{wrap\ 446}# - #{id\ 3481}# - #{w\ 3465}# - #{id-mod\ 3486}#))))) - (if (eqv? #{atom-key\ 3491}# - 'displaced-lexical) - (syntax-violation - 'set! - "identifier out of context" - (#{wrap\ 446}# - #{id\ 3481}# - #{w\ 3465}# - #{mod\ 3467}#)) - (syntax-violation - 'set! - "bad set!" - (#{source-wrap\ 448}# - #{e\ 3463}# - #{w\ 3465}# - #{s\ 3466}# - #{mod\ 3467}#))))))))))))) - #{tmp\ 3474}#) - (let ((#{tmp\ 3503}# - ($sc-dispatch - #{tmp\ 3473}# - '(_ (any . each-any) any)))) - (if #{tmp\ 3503}# - (@apply - (lambda (#{head\ 3507}# - #{tail\ 3508}# - #{val\ 3509}#) - (call-with-values - (lambda () - (#{syntax-type\ 458}# - #{head\ 3507}# - #{r\ 3464}# - '(()) - #f - #f - #{mod\ 3467}# - #t)) - (lambda (#{type\ 3512}# - #{value\ 3513}# - #{ee\ 3514}# - #{ww\ 3515}# - #{ss\ 3516}# - #{modmod\ 3517}#) - (if (eqv? #{type\ 3512}# 'module-ref) + (let ((#{when-list\ 1683}# + (#{chi-when-list\ 452}# + #{e\ 1642}# + #{x\ 1678}# + #{w\ 1643}#)) + (#{body\ 1684}# + (cons #{e1\ 1679}# + #{e2\ 1680}#))) + (if (eq? #{m\ 1619}# 'e) + (if (memq 'eval + #{when-list\ 1683}#) + (#{scan\ 1614}# + #{body\ 1684}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + (if (memq 'expand + #{when-list\ 1683}#) + 'c&e + 'e) + '(eval) + #{mod\ 1645}# + #{exps\ 1622}#) + (begin + (if (memq 'expand + #{when-list\ 1683}#) + (#{top-level-eval-hook\ 287}# + (#{chi-top-sequence\ 448}# + #{body\ 1684}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + 'e + '(eval) + #{mod\ 1645}#) + #{mod\ 1645}#)) + #{exps\ 1622}#)) + (if (memq 'load + #{when-list\ 1683}#) + (if (begin + (let ((#{t\ 1693}# + (memq 'compile + #{when-list\ 1683}#))) + (if #{t\ 1693}# + #{t\ 1693}# + (begin + (let ((#{t\ 1696}# + (memq 'expand + #{when-list\ 1683}#))) + (if #{t\ 1696}# + #{t\ 1696}# + (if (eq? #{m\ 1619}# + 'c&e) + (memq 'eval + #{when-list\ 1683}#) + #f))))))) + (#{scan\ 1614}# + #{body\ 1684}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + 'c&e + '(compile load) + #{mod\ 1645}# + #{exps\ 1622}#) + (if (if (eq? #{m\ 1619}# + 'c) + #t + (eq? #{m\ 1619}# + 'c&e)) + (#{scan\ 1614}# + #{body\ 1684}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + 'c + '(load) + #{mod\ 1645}# + #{exps\ 1622}#) + #{exps\ 1622}#)) + (if (begin + (let ((#{t\ 1704}# + (memq 'compile + #{when-list\ 1683}#))) + (if #{t\ 1704}# + #{t\ 1704}# + (begin + (let ((#{t\ 1707}# + (memq 'expand + #{when-list\ 1683}#))) + (if #{t\ 1707}# + #{t\ 1707}# + (if (eq? #{m\ 1619}# + 'c&e) + (memq 'eval + #{when-list\ 1683}#) + #f))))))) + (begin + (#{top-level-eval-hook\ 287}# + (#{chi-top-sequence\ 448}# + #{body\ 1684}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + 'e + '(eval) + #{mod\ 1645}#) + #{mod\ 1645}#) + #{exps\ 1622}#) + #{exps\ 1622}#)))))) + #{tmp\ 1674}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1673}#)))) + (if (eqv? #{type\ 1640}# 'define-syntax-form) (begin - (let ((#{val\ 3526}# - (#{chi\ 460}# - #{val\ 3509}# - #{r\ 3464}# - #{w\ 3465}# - #{mod\ 3467}#))) - (call-with-values - (lambda () - (#{value\ 3513}# - (cons #{head\ 3507}# - #{tail\ 3508}#) - #{r\ 3464}# - #{w\ 3465}#)) - (lambda (#{e\ 3528}# - #{r\ 3529}# - #{w\ 3530}# - #{s*\ 3531}# - #{mod\ 3532}#) - (let ((#{tmp\ 3538}# #{e\ 3528}#)) - (let ((#{tmp\ 3539}# - (list #{tmp\ 3538}#))) - (if (if #{tmp\ 3539}# - (@apply - (lambda (#{e\ 3541}#) - (#{id?\ 380}# - #{e\ 3541}#)) - #{tmp\ 3539}#) - #f) - (@apply - (lambda (#{e\ 3543}#) - (#{build-global-assignment\ 320}# - #{s\ 3466}# - (syntax->datum - #{e\ 3543}#) - #{val\ 3526}# - #{mod\ 3532}#)) - #{tmp\ 3539}#) + (let ((#{n\ 1715}# + (#{id-var-name\ 430}# + #{value\ 1641}# + #{w\ 1643}#)) + (#{r\ 1716}# + (#{macros-only-env\ 368}# + #{r\ 1616}#))) + (if (eqv? #{m\ 1619}# 'c) + (if (memq 'compile #{esew\ 1620}#) + (begin + (let ((#{e\ 1719}# + (#{chi-install-global\ 450}# + #{n\ 1715}# + (#{chi\ 456}# + #{e\ 1642}# + #{r\ 1716}# + #{w\ 1643}# + #{mod\ 1645}#)))) + (begin + (#{top-level-eval-hook\ 287}# + #{e\ 1719}# + #{mod\ 1645}#) + (if (memq 'load + #{esew\ 1620}#) + (cons #{e\ 1719}# + #{exps\ 1622}#) + #{exps\ 1622}#)))) + (if (memq 'load #{esew\ 1620}#) + (cons (#{chi-install-global\ 450}# + #{n\ 1715}# + (#{chi\ 456}# + #{e\ 1642}# + #{r\ 1716}# + #{w\ 1643}# + #{mod\ 1645}#)) + #{exps\ 1622}#) + #{exps\ 1622}#)) + (if (eqv? #{m\ 1619}# 'c&e) + (begin + (let ((#{e\ 1722}# + (#{chi-install-global\ 450}# + #{n\ 1715}# + (#{chi\ 456}# + #{e\ 1642}# + #{r\ 1716}# + #{w\ 1643}# + #{mod\ 1645}#)))) + (begin + (#{top-level-eval-hook\ 287}# + #{e\ 1722}# + #{mod\ 1645}#) + (cons #{e\ 1722}# + #{exps\ 1622}#)))) + (begin + (if (memq 'eval #{esew\ 1620}#) + (#{top-level-eval-hook\ 287}# + (#{chi-install-global\ 450}# + #{n\ 1715}# + (#{chi\ 456}# + #{e\ 1642}# + #{r\ 1716}# + #{w\ 1643}# + #{mod\ 1645}#)) + #{mod\ 1645}#)) + #{exps\ 1622}#))))) + (if (eqv? #{type\ 1640}# 'define-form) + (begin + (let ((#{n\ 1727}# + (#{id-var-name\ 430}# + #{value\ 1641}# + #{w\ 1643}#))) + (begin + (let ((#{type\ 1729}# + (car (#{lookup\ 370}# + #{n\ 1727}# + #{r\ 1616}# + #{mod\ 1645}#)))) + (if (if (eqv? #{type\ 1729}# + 'global) + #t + (if (eqv? #{type\ 1729}# + 'core) + #t + (if (eqv? #{type\ 1729}# + 'macro) + #t + (eqv? #{type\ 1729}# + 'module-ref)))) + (begin + (if (if (if (eq? #{m\ 1619}# + 'c) + #t + (eq? #{m\ 1619}# + 'c&e)) + (if (not (module-local-variable + (current-module) + #{n\ 1727}#)) + (current-module) + #f) + #f) + (begin + (let ((#{old\ 1736}# + (module-variable + (current-module) + #{n\ 1727}#))) + (if (if (variable? + #{old\ 1736}#) + (variable-bound? + #{old\ 1736}#) + #f) + (module-define! + (current-module) + #{n\ 1727}# + (variable-ref + #{old\ 1736}#)) + (module-add! + (current-module) + #{n\ 1727}# + (make-undefined-variable)))))) + (cons (if (eq? #{m\ 1619}# + 'c&e) + (begin + (let ((#{x\ 1740}# + (#{build-global-definition\ 318}# + #{s\ 1644}# + #{n\ 1727}# + (#{chi\ 456}# + #{e\ 1642}# + #{r\ 1616}# + #{w\ 1643}# + #{mod\ 1645}#)))) + (begin + (#{top-level-eval-hook\ 287}# + #{x\ 1740}# + #{mod\ 1645}#) + #{x\ 1740}#))) + (lambda () + (#{build-global-definition\ 318}# + #{s\ 1644}# + #{n\ 1727}# + (#{chi\ 456}# + #{e\ 1642}# + #{r\ 1616}# + #{w\ 1643}# + #{mod\ 1645}#)))) + #{exps\ 1622}#)) + (if (eqv? #{type\ 1729}# + 'displaced-lexical) (syntax-violation #f - "source expression failed to match any pattern" - #{tmp\ 3538}#)))))))) - (#{build-application\ 306}# - #{s\ 3466}# - (#{chi\ 460}# - (list '#(syntax-object - setter - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(type - value - ee - ww - ss - modmod) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("i3518" - "i3519" - "i3520" - "i3521" - "i3522" - "i3523")) - #(ribcage - #(head tail val) - #((top) (top) (top)) - #("i3504" "i3505" "i3506")) - #(ribcage () () ()) - #(ribcage - #(e r w s mod) - #((top) - (top) - (top) - (top) - (top)) - #("i3468" - "i3469" - "i3470" - "i3471" - "i3472")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile)) - #{head\ 3507}#) - #{r\ 3464}# - #{w\ 3465}# - #{mod\ 3467}#) - (map (lambda (#{e\ 3545}#) - (#{chi\ 460}# - #{e\ 3545}# - #{r\ 3464}# - #{w\ 3465}# - #{mod\ 3467}#)) - (append - #{tail\ 3508}# - (list #{val\ 3509}#)))))))) - #{tmp\ 3503}#) - (let ((#{_\ 3549}# #{tmp\ 3473}#)) - (syntax-violation - 'set! - "bad set!" - (#{source-wrap\ 448}# - #{e\ 3463}# - #{w\ 3465}# - #{s\ 3466}# - #{mod\ 3467}#)))))))))) - (#{global-extend\ 376}# - 'module-ref - '@ - (lambda (#{e\ 3550}# #{r\ 3551}# #{w\ 3552}#) - (let ((#{tmp\ 3556}# #{e\ 3550}#)) - (let ((#{tmp\ 3557}# - ($sc-dispatch #{tmp\ 3556}# '(_ each-any any)))) - (if (if #{tmp\ 3557}# - (@apply - (lambda (#{mod\ 3560}# #{id\ 3561}#) - (if (and-map #{id?\ 380}# #{mod\ 3560}#) - (#{id?\ 380}# #{id\ 3561}#) - #f)) - #{tmp\ 3557}#) - #f) - (@apply - (lambda (#{mod\ 3567}# #{id\ 3568}#) - (values - (syntax->datum #{id\ 3568}#) - #{r\ 3551}# - #{w\ 3552}# - #f - (syntax->datum - (cons '#(syntax-object - public - ((top) - #(ribcage - #(mod id) - #((top) (top)) - #("i3565" "i3566")) - #(ribcage () () ()) - #(ribcage - #(e r w) - #((top) (top) (top)) - #("i3553" "i3554" "i3555")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile)) - #{mod\ 3567}#)))) - #{tmp\ 3557}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 3556}#)))))) - (#{global-extend\ 376}# - 'module-ref - '@@ - (lambda (#{e\ 3570}# #{r\ 3571}# #{w\ 3572}#) - (letrec* - ((#{remodulate\ 3577}# - (lambda (#{x\ 3578}# #{mod\ 3579}#) - (if (pair? #{x\ 3578}#) - (cons (#{remodulate\ 3577}# - (car #{x\ 3578}#) - #{mod\ 3579}#) - (#{remodulate\ 3577}# - (cdr #{x\ 3578}#) - #{mod\ 3579}#)) - (if (#{syntax-object?\ 346}# #{x\ 3578}#) - (#{make-syntax-object\ 344}# - (#{remodulate\ 3577}# - (#{syntax-object-expression\ 348}# #{x\ 3578}#) - #{mod\ 3579}#) - (#{syntax-object-wrap\ 350}# #{x\ 3578}#) - #{mod\ 3579}#) - (if (vector? #{x\ 3578}#) - (begin - (let ((#{n\ 3590}# (vector-length #{x\ 3578}#))) - (begin - (let ((#{v\ 3592}# - (make-vector #{n\ 3590}#))) - (letrec* - ((#{loop\ 3595}# - (lambda (#{i\ 3596}#) - (if (#{fx=\ 287}# - #{i\ 3596}# - #{n\ 3590}#) - (begin (if #f #f) #{v\ 3592}#) + "identifier out of context" + #{e\ 1642}# + (#{wrap\ 442}# + #{value\ 1641}# + #{w\ 1643}# + #{mod\ 1645}#)) + (syntax-violation + #f + "cannot define keyword at top level" + #{e\ 1642}# + (#{wrap\ 442}# + #{value\ 1641}# + #{w\ 1643}# + #{mod\ 1645}#)))))))) + (cons (if (eq? #{m\ 1619}# 'c&e) (begin - (vector-set! - #{v\ 3592}# - #{i\ 3596}# - (#{remodulate\ 3577}# - (vector-ref - #{x\ 3578}# - #{i\ 3596}#) - #{mod\ 3579}#)) - (#{loop\ 3595}# - (#{fx+\ 283}# - #{i\ 3596}# - 1))))))) - (begin (#{loop\ 3595}# 0))))))) - #{x\ 3578}#)))))) - (begin - (let ((#{tmp\ 3600}# #{e\ 3570}#)) - (let ((#{tmp\ 3601}# - ($sc-dispatch #{tmp\ 3600}# '(_ each-any any)))) - (if (if #{tmp\ 3601}# - (@apply - (lambda (#{mod\ 3604}# #{exp\ 3605}#) - (and-map #{id?\ 380}# #{mod\ 3604}#)) - #{tmp\ 3601}#) - #f) - (@apply - (lambda (#{mod\ 3609}# #{exp\ 3610}#) - (begin - (let ((#{mod\ 3612}# - (syntax->datum - (cons '#(syntax-object - private - ((top) - #(ribcage - #(mod exp) - #((top) (top)) - #("i3607" "i3608")) - #(ribcage - (remodulate) - ((top)) - ("i3576")) - #(ribcage - #(e r w) - #((top) (top) (top)) - #("i3573" - "i3574" - "i3575")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" - "i40" - "i39" - "i37"))) - (hygiene guile)) - #{mod\ 3609}#)))) - (values - (#{remodulate\ 3577}# - #{exp\ 3610}# - #{mod\ 3612}#) - #{r\ 3571}# - #{w\ 3572}# - (#{source-annotation\ 361}# #{exp\ 3610}#) - #{mod\ 3612}#)))) - #{tmp\ 3601}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 3600}#)))))))) - (#{global-extend\ 376}# - 'core - 'if - (lambda (#{e\ 3614}# - #{r\ 3615}# - #{w\ 3616}# - #{s\ 3617}# - #{mod\ 3618}#) - (let ((#{tmp\ 3624}# #{e\ 3614}#)) - (let ((#{tmp\ 3625}# - ($sc-dispatch #{tmp\ 3624}# '(_ any any)))) - (if #{tmp\ 3625}# - (@apply - (lambda (#{test\ 3628}# #{then\ 3629}#) - (#{build-conditional\ 308}# - #{s\ 3617}# - (#{chi\ 460}# - #{test\ 3628}# - #{r\ 3615}# - #{w\ 3616}# - #{mod\ 3618}#) - (#{chi\ 460}# - #{then\ 3629}# - #{r\ 3615}# - #{w\ 3616}# - #{mod\ 3618}#) - (#{build-void\ 304}# #f))) - #{tmp\ 3625}#) - (let ((#{tmp\ 3631}# - ($sc-dispatch #{tmp\ 3624}# '(_ any any any)))) - (if #{tmp\ 3631}# - (@apply - (lambda (#{test\ 3635}# - #{then\ 3636}# - #{else\ 3637}#) - (#{build-conditional\ 308}# - #{s\ 3617}# - (#{chi\ 460}# - #{test\ 3635}# - #{r\ 3615}# - #{w\ 3616}# - #{mod\ 3618}#) - (#{chi\ 460}# - #{then\ 3636}# - #{r\ 3615}# - #{w\ 3616}# - #{mod\ 3618}#) - (#{chi\ 460}# - #{else\ 3637}# - #{r\ 3615}# - #{w\ 3616}# - #{mod\ 3618}#))) - #{tmp\ 3631}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 3624}#)))))))) - (#{global-extend\ 376}# - 'core - 'with-fluids - (lambda (#{e\ 3638}# - #{r\ 3639}# - #{w\ 3640}# - #{s\ 3641}# - #{mod\ 3642}#) - (let ((#{tmp\ 3648}# #{e\ 3638}#)) - (let ((#{tmp\ 3649}# - ($sc-dispatch - #{tmp\ 3648}# - '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 3649}# - (@apply - (lambda (#{fluid\ 3654}# - #{val\ 3655}# - #{b\ 3656}# - #{b*\ 3657}#) - (#{build-dynlet\ 310}# - #{s\ 3641}# - (map (lambda (#{x\ 3658}#) - (#{chi\ 460}# - #{x\ 3658}# - #{r\ 3639}# - #{w\ 3640}# - #{mod\ 3642}#)) - #{fluid\ 3654}#) - (map (lambda (#{x\ 3661}#) - (#{chi\ 460}# - #{x\ 3661}# - #{r\ 3639}# - #{w\ 3640}# - #{mod\ 3642}#)) - #{val\ 3655}#) - (#{chi-body\ 468}# - (cons #{b\ 3656}# #{b*\ 3657}#) - (#{source-wrap\ 448}# - #{e\ 3638}# - #{w\ 3640}# - #{s\ 3641}# - #{mod\ 3642}#) - #{r\ 3639}# - #{w\ 3640}# - #{mod\ 3642}#))) - #{tmp\ 3649}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 3648}#)))))) - (#{global-extend\ 376}# 'begin 'begin '()) - (#{global-extend\ 376}# 'define 'define '()) - (#{global-extend\ 376}# - 'define-syntax - 'define-syntax - '()) - (#{global-extend\ 376}# - 'eval-when - 'eval-when - '()) - (#{global-extend\ 376}# - 'core - 'syntax-case - (letrec* - ((#{convert-pattern\ 3666}# - (lambda (#{pattern\ 3673}# #{keys\ 3674}#) - (letrec* - ((#{cvt*\ 3678}# - (lambda (#{p*\ 3681}# #{n\ 3682}# #{ids\ 3683}#) - (if (null? #{p*\ 3681}#) - (values '() #{ids\ 3683}#) - (call-with-values - (lambda () - (#{cvt*\ 3678}# - (cdr #{p*\ 3681}#) - #{n\ 3682}# - #{ids\ 3683}#)) - (lambda (#{y\ 3687}# #{ids\ 3688}#) - (call-with-values - (lambda () - (#{cvt\ 3680}# - (car #{p*\ 3681}#) - #{n\ 3682}# - #{ids\ 3688}#)) - (lambda (#{x\ 3691}# #{ids\ 3692}#) - (values - (cons #{x\ 3691}# #{y\ 3687}#) - #{ids\ 3692}#)))))))) - (#{cvt\ 3680}# - (lambda (#{p\ 3695}# #{n\ 3696}# #{ids\ 3697}#) - (if (#{id?\ 380}# #{p\ 3695}#) - (if (#{bound-id-member?\ 444}# - #{p\ 3695}# - #{keys\ 3674}#) - (values - (vector 'free-id #{p\ 3695}#) - #{ids\ 3697}#) - (if (#{free-id=?\ 436}# - #{p\ 3695}# + (let ((#{x\ 1745}# + (#{chi-expr\ 458}# + #{type\ 1640}# + #{value\ 1641}# + #{e\ 1642}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + #{mod\ 1645}#))) + (begin + (#{top-level-eval-hook\ 287}# + #{x\ 1745}# + #{mod\ 1645}#) + #{x\ 1745}#))) + (lambda () + (#{chi-expr\ 458}# + #{type\ 1640}# + #{value\ 1641}# + #{e\ 1642}# + #{r\ 1616}# + #{w\ 1643}# + #{s\ 1644}# + #{mod\ 1645}#))) + #{exps\ 1622}#))))))))) + (lambda (#{exps\ 1746}#) + (#{scan\ 1614}# + (cdr #{body\ 1615}#) + #{r\ 1616}# + #{w\ 1617}# + #{s\ 1618}# + #{m\ 1619}# + #{esew\ 1620}# + #{mod\ 1621}# + #{exps\ 1746}#))))))) + (begin + (call-with-values + (lambda () + (#{scan\ 1614}# + #{body\ 1599}# + #{r\ 1600}# + #{w\ 1601}# + #{s\ 1602}# + #{m\ 1603}# + #{esew\ 1604}# + #{mod\ 1605}# + '())) + (lambda (#{exps\ 1748}#) + (if (null? #{exps\ 1748}#) + (#{build-void\ 300}# #{s\ 1602}#) + (#{build-sequence\ 330}# + #{s\ 1602}# + (letrec* + ((#{lp\ 1753}# + (lambda (#{in\ 1754}# #{out\ 1755}#) + (if (null? #{in\ 1754}#) + #{out\ 1755}# + (begin + (let ((#{e\ 1757}# (car #{in\ 1754}#))) + (#{lp\ 1753}# + (cdr #{in\ 1754}#) + (cons (if (procedure? #{e\ 1757}#) + (#{e\ 1757}#) + #{e\ 1757}#) + #{out\ 1755}#)))))))) + (begin (#{lp\ 1753}# #{exps\ 1748}# '()))))))))))) + (#{chi-install-global\ 450}# + (lambda (#{name\ 1758}# #{e\ 1759}#) + (#{build-global-definition\ 318}# + #f + #{name\ 1758}# + (#{build-application\ 302}# + #f + (#{build-primref\ 326}# + #f + 'make-syntax-transformer) + (list (#{build-data\ 328}# #f #{name\ 1758}#) + (#{build-data\ 328}# #f 'macro) + #{e\ 1759}#))))) + (#{chi-when-list\ 452}# + (lambda (#{e\ 1767}# #{when-list\ 1768}# #{w\ 1769}#) + (letrec* + ((#{f\ 1776}# + (lambda (#{when-list\ 1777}# #{situations\ 1778}#) + (if (null? #{when-list\ 1777}#) + #{situations\ 1778}# + (#{f\ 1776}# + (cdr #{when-list\ 1777}#) + (cons (begin + (let ((#{x\ 1780}# (car #{when-list\ 1777}#))) + (if (#{free-id=?\ 432}# + #{x\ 1780}# '#(syntax-object - _ + compile ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("i1779")) #(ribcage () () ()) #(ribcage - #(p n ids) + #(f when-list situations) #((top) (top) (top)) - #("i3698" "i3699" "i3700")) + #("i1773" "i1774" "i1775")) + #(ribcage () () ()) #(ribcage - (cvt cvt*) - ((top) (top)) - ("i3679" "i3677")) - #(ribcage - #(pattern keys) - #((top) (top)) - #("i3675" "i3676")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("i3671" "i3669" "i3667" "i3665")) + #(e when-list w) + #((top) (top) (top)) + #("i1770" "i1771" "i1772")) #(ribcage (lambda-var-list gen-var @@ -12112,9 +1865,7 @@ (top) (top) (top)) - ("i489" - "i487" - "i485" + ("i485" "i483" "i481" "i479" @@ -12147,14 +1898,14 @@ "i425" "i423" "i421" - "i420" "i419" "i417" "i416" "i415" - "i414" "i413" + "i412" "i411" + "i410" "i409" "i407" "i405" @@ -12162,33 +1913,33 @@ "i401" "i399" "i397" - "i394" - "i392" - "i391" + "i395" + "i393" "i390" - "i389" "i388" "i387" "i386" "i385" "i384" + "i383" "i382" "i381" - "i379" + "i380" + "i378" "i377" "i375" "i373" "i371" "i369" "i367" - "i366" "i365" - "i364" "i363" "i362" + "i361" "i360" "i359" - "i357" + "i358" + "i356" "i355" "i353" "i351" @@ -12220,12 +1971,14 @@ "i299" "i297" "i295" - "i294" - "i292" + "i293" + "i291" "i290" "i288" "i286" + "i285" "i284" + "i283" "i282" "i280" "i278" @@ -12256,345 +2009,5130 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile))) - (values '_ #{ids\ 3697}#) - (values - 'any - (cons (cons #{p\ 3695}# #{n\ 3696}#) - #{ids\ 3697}#)))) - (let ((#{tmp\ 3706}# #{p\ 3695}#)) - (let ((#{tmp\ 3707}# + 'compile + (if (#{free-id=?\ 432}# + #{x\ 1780}# + '#(syntax-object + load + ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("i1779")) + #(ribcage () () ()) + #(ribcage + #(f when-list situations) + #((top) (top) (top)) + #("i1773" "i1774" "i1775")) + #(ribcage () () ()) + #(ribcage + #(e when-list w) + #((top) (top) (top)) + #("i1770" "i1771" "i1772")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile))) + 'load + (if (#{free-id=?\ 432}# + #{x\ 1780}# + '#(syntax-object + eval + ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(x) + #((top)) + #("i1779")) + #(ribcage () () ()) + #(ribcage + #(f when-list situations) + #((top) (top) (top)) + #("i1773" "i1774" "i1775")) + #(ribcage () () ()) + #(ribcage + #(e when-list w) + #((top) (top) (top)) + #("i1770" "i1771" "i1772")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile))) + 'eval + (if (#{free-id=?\ 432}# + #{x\ 1780}# + '#(syntax-object + expand + ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(x) + #((top)) + #("i1779")) + #(ribcage () () ()) + #(ribcage + #(f when-list situations) + #((top) (top) (top)) + #("i1773" "i1774" "i1775")) + #(ribcage () () ()) + #(ribcage + #(e when-list w) + #((top) (top) (top)) + #("i1770" "i1771" "i1772")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile))) + 'expand + (syntax-violation + 'eval-when + "invalid situation" + #{e\ 1767}# + (#{wrap\ 442}# + #{x\ 1780}# + #{w\ 1769}# + #f)))))))) + #{situations\ 1778}#)))))) + (begin (#{f\ 1776}# #{when-list\ 1768}# '()))))) + (#{syntax-type\ 454}# + (lambda (#{e\ 1790}# + #{r\ 1791}# + #{w\ 1792}# + #{s\ 1793}# + #{rib\ 1794}# + #{mod\ 1795}# + #{for-car?\ 1796}#) + (if (symbol? #{e\ 1790}#) + (begin + (let ((#{n\ 1808}# + (#{id-var-name\ 430}# #{e\ 1790}# #{w\ 1792}#))) + (begin + (let ((#{b\ 1810}# + (#{lookup\ 370}# + #{n\ 1808}# + #{r\ 1791}# + #{mod\ 1795}#))) + (begin + (let ((#{type\ 1812}# (car #{b\ 1810}#))) + (if (eqv? #{type\ 1812}# 'lexical) + (values + #{type\ 1812}# + (cdr #{b\ 1810}#) + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{type\ 1812}# 'global) + (values + #{type\ 1812}# + #{n\ 1808}# + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{type\ 1812}# 'macro) + (if #{for-car?\ 1796}# + (values + #{type\ 1812}# + (cdr #{b\ 1810}#) + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (#{syntax-type\ 454}# + (#{chi-macro\ 462}# + (cdr #{b\ 1810}#) + #{e\ 1790}# + #{r\ 1791}# + #{w\ 1792}# + #{s\ 1793}# + #{rib\ 1794}# + #{mod\ 1795}#) + #{r\ 1791}# + '(()) + #{s\ 1793}# + #{rib\ 1794}# + #{mod\ 1795}# + #f)) + (values + #{type\ 1812}# + (cdr #{b\ 1810}#) + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#)))))))))) + (if (pair? #{e\ 1790}#) + (begin + (let ((#{first\ 1826}# (car #{e\ 1790}#))) + (call-with-values + (lambda () + (#{syntax-type\ 454}# + #{first\ 1826}# + #{r\ 1791}# + #{w\ 1792}# + #{s\ 1793}# + #{rib\ 1794}# + #{mod\ 1795}# + #t)) + (lambda (#{ftype\ 1827}# + #{fval\ 1828}# + #{fe\ 1829}# + #{fw\ 1830}# + #{fs\ 1831}# + #{fmod\ 1832}#) + (if (eqv? #{ftype\ 1827}# 'lexical) + (values + 'lexical-call + #{fval\ 1828}# + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{ftype\ 1827}# 'global) + (values + 'global-call + (#{make-syntax-object\ 340}# + #{fval\ 1828}# + #{w\ 1792}# + #{fmod\ 1832}#) + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{ftype\ 1827}# 'macro) + (#{syntax-type\ 454}# + (#{chi-macro\ 462}# + #{fval\ 1828}# + #{e\ 1790}# + #{r\ 1791}# + #{w\ 1792}# + #{s\ 1793}# + #{rib\ 1794}# + #{mod\ 1795}#) + #{r\ 1791}# + '(()) + #{s\ 1793}# + #{rib\ 1794}# + #{mod\ 1795}# + #{for-car?\ 1796}#) + (if (eqv? #{ftype\ 1827}# 'module-ref) + (call-with-values + (lambda () + (#{fval\ 1828}# + #{e\ 1790}# + #{r\ 1791}# + #{w\ 1792}#)) + (lambda (#{e\ 1844}# + #{r\ 1845}# + #{w\ 1846}# + #{s\ 1847}# + #{mod\ 1848}#) + (#{syntax-type\ 454}# + #{e\ 1844}# + #{r\ 1845}# + #{w\ 1846}# + #{s\ 1847}# + #{rib\ 1794}# + #{mod\ 1848}# + #{for-car?\ 1796}#))) + (if (eqv? #{ftype\ 1827}# 'core) + (values + 'core-form + #{fval\ 1828}# + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{ftype\ 1827}# 'local-syntax) + (values + 'local-syntax-form + #{fval\ 1828}# + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{ftype\ 1827}# 'begin) + (values + 'begin-form + #f + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{ftype\ 1827}# 'eval-when) + (values + 'eval-when-form + #f + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (if (eqv? #{ftype\ 1827}# 'define) + (let ((#{tmp\ 1859}# #{e\ 1790}#)) + (let ((#{tmp\ 1860}# + ($sc-dispatch + #{tmp\ 1859}# + '(_ any any)))) + (if (if #{tmp\ 1860}# + (@apply + (lambda (#{name\ 1863}# + #{val\ 1864}#) + (#{id?\ 376}# + #{name\ 1863}#)) + #{tmp\ 1860}#) + #f) + (@apply + (lambda (#{name\ 1867}# + #{val\ 1868}#) + (values + 'define-form + #{name\ 1867}# + #{val\ 1868}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#)) + #{tmp\ 1860}#) + (let ((#{tmp\ 1869}# + ($sc-dispatch + #{tmp\ 1859}# + '(_ (any . any) + any + . + each-any)))) + (if (if #{tmp\ 1869}# + (@apply + (lambda (#{name\ 1874}# + #{args\ 1875}# + #{e1\ 1876}# + #{e2\ 1877}#) + (if (#{id?\ 376}# + #{name\ 1874}#) + (#{valid-bound-ids?\ 436}# + (#{lambda-var-list\ 486}# + #{args\ 1875}#)) + #f)) + #{tmp\ 1869}#) + #f) + (@apply + (lambda (#{name\ 1884}# + #{args\ 1885}# + #{e1\ 1886}# + #{e2\ 1887}#) + (values + 'define-form + (#{wrap\ 442}# + #{name\ 1884}# + #{w\ 1792}# + #{mod\ 1795}#) + (#{decorate-source\ 296}# + (cons '#(syntax-object + lambda + ((top) + #(ribcage + #(name + args + e1 + e2) + #((top) + (top) + (top) + (top)) + #("i1880" + "i1881" + "i1882" + "i1883")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(ftype + fval + fe + fw + fs + fmod) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("i1833" + "i1834" + "i1835" + "i1836" + "i1837" + "i1838")) + #(ribcage + () + () + ()) + #(ribcage + #(first) + #((top)) + #("i1825")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(e + r + w + s + rib + mod + for-car?) + #((top) + (top) + (top) + (top) + (top) + (top) + (top)) + #("i1797" + "i1798" + "i1799" + "i1800" + "i1801" + "i1802" + "i1803")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) + (top) + (top) + (top)) + ("i41" + "i40" + "i39" + "i37"))) + (hygiene + guile)) + (#{wrap\ 442}# + (cons #{args\ 1885}# + (cons #{e1\ 1886}# + #{e2\ 1887}#)) + #{w\ 1792}# + #{mod\ 1795}#)) + #{s\ 1793}#) + '(()) + #{s\ 1793}# + #{mod\ 1795}#)) + #{tmp\ 1869}#) + (let ((#{tmp\ 1890}# + ($sc-dispatch + #{tmp\ 1859}# + '(_ any)))) + (if (if #{tmp\ 1890}# + (@apply + (lambda (#{name\ 1892}#) + (#{id?\ 376}# + #{name\ 1892}#)) + #{tmp\ 1890}#) + #f) + (@apply + (lambda (#{name\ 1894}#) + (values + 'define-form + (#{wrap\ 442}# + #{name\ 1894}# + #{w\ 1792}# + #{mod\ 1795}#) + '(#(syntax-object + if + ((top) + #(ribcage + #(name) + #((top)) + #("i1893")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(ftype + fval + fe + fw + fs + fmod) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("i1833" + "i1834" + "i1835" + "i1836" + "i1837" + "i1838")) + #(ribcage + () + () + ()) + #(ribcage + #(first) + #((top)) + #("i1825")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(e + r + w + s + rib + mod + for-car?) + #((top) + (top) + (top) + (top) + (top) + (top) + (top)) + #("i1797" + "i1798" + "i1799" + "i1800" + "i1801" + "i1802" + "i1803")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) + (top) + (top) + (top)) + ("i41" + "i40" + "i39" + "i37"))) + (hygiene + guile)) + #(syntax-object + #f + ((top) + #(ribcage + #(name) + #((top)) + #("i1893")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(ftype + fval + fe + fw + fs + fmod) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("i1833" + "i1834" + "i1835" + "i1836" + "i1837" + "i1838")) + #(ribcage + () + () + ()) + #(ribcage + #(first) + #((top)) + #("i1825")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(e + r + w + s + rib + mod + for-car?) + #((top) + (top) + (top) + (top) + (top) + (top) + (top)) + #("i1797" + "i1798" + "i1799" + "i1800" + "i1801" + "i1802" + "i1803")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) + (top) + (top) + (top)) + ("i41" + "i40" + "i39" + "i37"))) + (hygiene + guile)) + #(syntax-object + #f + ((top) + #(ribcage + #(name) + #((top)) + #("i1893")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(ftype + fval + fe + fw + fs + fmod) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("i1833" + "i1834" + "i1835" + "i1836" + "i1837" + "i1838")) + #(ribcage + () + () + ()) + #(ribcage + #(first) + #((top)) + #("i1825")) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(e + r + w + s + rib + mod + for-car?) + #((top) + (top) + (top) + (top) + (top) + (top) + (top)) + #("i1797" + "i1798" + "i1799" + "i1800" + "i1801" + "i1802" + "i1803")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) + (top) + (top) + (top)) + ("i41" + "i40" + "i39" + "i37"))) + (hygiene + guile))) + '(()) + #{s\ 1793}# + #{mod\ 1795}#)) + #{tmp\ 1890}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1859}#)))))))) + (if (eqv? #{ftype\ 1827}# + 'define-syntax) + (let ((#{tmp\ 1897}# #{e\ 1790}#)) + (let ((#{tmp\ 1898}# + ($sc-dispatch + #{tmp\ 1897}# + '(_ any any)))) + (if (if #{tmp\ 1898}# + (@apply + (lambda (#{name\ 1901}# + #{val\ 1902}#) + (#{id?\ 376}# + #{name\ 1901}#)) + #{tmp\ 1898}#) + #f) + (@apply + (lambda (#{name\ 1905}# + #{val\ 1906}#) + (values + 'define-syntax-form + #{name\ 1905}# + #{val\ 1906}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#)) + #{tmp\ 1898}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1897}#)))) + (values + 'call + #f + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#))))))))))))))) + (if (#{syntax-object?\ 342}# #{e\ 1790}#) + (#{syntax-type\ 454}# + (#{syntax-object-expression\ 344}# #{e\ 1790}#) + #{r\ 1791}# + (#{join-wraps\ 424}# + #{w\ 1792}# + (#{syntax-object-wrap\ 346}# #{e\ 1790}#)) + (begin + (let ((#{t\ 1912}# + (#{source-annotation\ 357}# #{e\ 1790}#))) + (if #{t\ 1912}# #{t\ 1912}# #{s\ 1793}#))) + #{rib\ 1794}# + (begin + (let ((#{t\ 1916}# + (#{syntax-object-module\ 348}# #{e\ 1790}#))) + (if #{t\ 1916}# #{t\ 1916}# #{mod\ 1795}#))) + #{for-car?\ 1796}#) + (if (self-evaluating? #{e\ 1790}#) + (values + 'constant + #f + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#) + (values + 'other + #f + #{e\ 1790}# + #{w\ 1792}# + #{s\ 1793}# + #{mod\ 1795}#))))))) + (#{chi\ 456}# + (lambda (#{e\ 1921}# + #{r\ 1922}# + #{w\ 1923}# + #{mod\ 1924}#) + (call-with-values + (lambda () + (#{syntax-type\ 454}# + #{e\ 1921}# + #{r\ 1922}# + #{w\ 1923}# + (#{source-annotation\ 357}# #{e\ 1921}#) + #f + #{mod\ 1924}# + #f)) + (lambda (#{type\ 1929}# + #{value\ 1930}# + #{e\ 1931}# + #{w\ 1932}# + #{s\ 1933}# + #{mod\ 1934}#) + (#{chi-expr\ 458}# + #{type\ 1929}# + #{value\ 1930}# + #{e\ 1931}# + #{r\ 1922}# + #{w\ 1932}# + #{s\ 1933}# + #{mod\ 1934}#))))) + (#{chi-expr\ 458}# + (lambda (#{type\ 1941}# + #{value\ 1942}# + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + (if (eqv? #{type\ 1941}# 'lexical) + (#{build-lexical-reference\ 308}# + 'value + #{s\ 1946}# + #{e\ 1943}# + #{value\ 1942}#) + (if (if (eqv? #{type\ 1941}# 'core) + #t + (eqv? #{type\ 1941}# 'core-form)) + (#{value\ 1942}# + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + (if (eqv? #{type\ 1941}# 'module-ref) + (call-with-values + (lambda () + (#{value\ 1942}# + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}#)) + (lambda (#{e\ 1958}# + #{r\ 1959}# + #{w\ 1960}# + #{s\ 1961}# + #{mod\ 1962}#) + (#{chi\ 456}# + #{e\ 1958}# + #{r\ 1959}# + #{w\ 1960}# + #{mod\ 1962}#))) + (if (eqv? #{type\ 1941}# 'lexical-call) + (#{chi-application\ 460}# + (begin + (let ((#{id\ 1970}# (car #{e\ 1943}#))) + (#{build-lexical-reference\ 308}# + 'fun + (#{source-annotation\ 357}# #{id\ 1970}#) + (if (#{syntax-object?\ 342}# #{id\ 1970}#) + (syntax->datum #{id\ 1970}#) + #{id\ 1970}#) + #{value\ 1942}#))) + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + (if (eqv? #{type\ 1941}# 'global-call) + (#{chi-application\ 460}# + (#{build-global-reference\ 314}# + (#{source-annotation\ 357}# (car #{e\ 1943}#)) + (if (#{syntax-object?\ 342}# #{value\ 1942}#) + (#{syntax-object-expression\ 344}# + #{value\ 1942}#) + #{value\ 1942}#) + (if (#{syntax-object?\ 342}# #{value\ 1942}#) + (#{syntax-object-module\ 348}# #{value\ 1942}#) + #{mod\ 1947}#)) + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + (if (eqv? #{type\ 1941}# 'constant) + (#{build-data\ 328}# + #{s\ 1946}# + (#{strip\ 482}# + (#{source-wrap\ 444}# + #{e\ 1943}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + '(()))) + (if (eqv? #{type\ 1941}# 'global) + (#{build-global-reference\ 314}# + #{s\ 1946}# + #{value\ 1942}# + #{mod\ 1947}#) + (if (eqv? #{type\ 1941}# 'call) + (#{chi-application\ 460}# + (#{chi\ 456}# + (car #{e\ 1943}#) + #{r\ 1944}# + #{w\ 1945}# + #{mod\ 1947}#) + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + (if (eqv? #{type\ 1941}# 'begin-form) + (let ((#{tmp\ 1977}# #{e\ 1943}#)) + (let ((#{tmp\ 1978}# + ($sc-dispatch + #{tmp\ 1977}# + '(_ any . each-any)))) + (if #{tmp\ 1978}# + (@apply + (lambda (#{e1\ 1981}# #{e2\ 1982}#) + (#{chi-sequence\ 446}# + (cons #{e1\ 1981}# #{e2\ 1982}#) + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#)) + #{tmp\ 1978}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1977}#)))) + (if (eqv? #{type\ 1941}# 'local-syntax-form) + (#{chi-local-syntax\ 466}# + #{value\ 1942}# + #{e\ 1943}# + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}# + #{chi-sequence\ 446}#) + (if (eqv? #{type\ 1941}# 'eval-when-form) + (let ((#{tmp\ 1986}# #{e\ 1943}#)) + (let ((#{tmp\ 1987}# + ($sc-dispatch + #{tmp\ 1986}# + '(_ each-any any . each-any)))) + (if #{tmp\ 1987}# + (@apply + (lambda (#{x\ 1991}# + #{e1\ 1992}# + #{e2\ 1993}#) + (begin + (let ((#{when-list\ 1995}# + (#{chi-when-list\ 452}# + #{e\ 1943}# + #{x\ 1991}# + #{w\ 1945}#))) + (if (memq 'eval + #{when-list\ 1995}#) + (#{chi-sequence\ 446}# + (cons #{e1\ 1992}# + #{e2\ 1993}#) + #{r\ 1944}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#) + (#{chi-void\ 470}#))))) + #{tmp\ 1987}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 1986}#)))) + (if (if (eqv? #{type\ 1941}# 'define-form) + #t + (eqv? #{type\ 1941}# + 'define-syntax-form)) + (syntax-violation + #f + "definition in expression context" + #{e\ 1943}# + (#{wrap\ 442}# + #{value\ 1942}# + #{w\ 1945}# + #{mod\ 1947}#)) + (if (eqv? #{type\ 1941}# 'syntax) + (syntax-violation + #f + "reference to pattern variable outside syntax form" + (#{source-wrap\ 444}# + #{e\ 1943}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#)) + (if (eqv? #{type\ 1941}# + 'displaced-lexical) + (syntax-violation + #f + "reference to identifier outside its scope" + (#{source-wrap\ 444}# + #{e\ 1943}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#)) + (syntax-violation + #f + "unexpected syntax" + (#{source-wrap\ 444}# + #{e\ 1943}# + #{w\ 1945}# + #{s\ 1946}# + #{mod\ 1947}#)))))))))))))))))) + (#{chi-application\ 460}# + (lambda (#{x\ 2002}# + #{e\ 2003}# + #{r\ 2004}# + #{w\ 2005}# + #{s\ 2006}# + #{mod\ 2007}#) + (let ((#{tmp\ 2014}# #{e\ 2003}#)) + (let ((#{tmp\ 2015}# + ($sc-dispatch #{tmp\ 2014}# '(any . each-any)))) + (if #{tmp\ 2015}# + (@apply + (lambda (#{e0\ 2018}# #{e1\ 2019}#) + (#{build-application\ 302}# + #{s\ 2006}# + #{x\ 2002}# + (map (lambda (#{e\ 2020}#) + (#{chi\ 456}# + #{e\ 2020}# + #{r\ 2004}# + #{w\ 2005}# + #{mod\ 2007}#)) + #{e1\ 2019}#))) + #{tmp\ 2015}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 2014}#)))))) + (#{chi-macro\ 462}# + (lambda (#{p\ 2023}# + #{e\ 2024}# + #{r\ 2025}# + #{w\ 2026}# + #{s\ 2027}# + #{rib\ 2028}# + #{mod\ 2029}#) + (letrec* + ((#{rebuild-macro-output\ 2038}# + (lambda (#{x\ 2039}# #{m\ 2040}#) + (if (pair? #{x\ 2039}#) + (#{decorate-source\ 296}# + (cons (#{rebuild-macro-output\ 2038}# + (car #{x\ 2039}#) + #{m\ 2040}#) + (#{rebuild-macro-output\ 2038}# + (cdr #{x\ 2039}#) + #{m\ 2040}#)) + #{s\ 2027}#) + (if (#{syntax-object?\ 342}# #{x\ 2039}#) + (begin + (let ((#{w\ 2048}# + (#{syntax-object-wrap\ 346}# #{x\ 2039}#))) + (begin + (let ((#{ms\ 2051}# (car #{w\ 2048}#)) + (#{s\ 2052}# (cdr #{w\ 2048}#))) + (if (if (pair? #{ms\ 2051}#) + (eq? (car #{ms\ 2051}#) #f) + #f) + (#{make-syntax-object\ 340}# + (#{syntax-object-expression\ 344}# + #{x\ 2039}#) + (cons (cdr #{ms\ 2051}#) + (if #{rib\ 2028}# + (cons #{rib\ 2028}# + (cdr #{s\ 2052}#)) + (cdr #{s\ 2052}#))) + (#{syntax-object-module\ 348}# #{x\ 2039}#)) + (#{make-syntax-object\ 340}# + (#{decorate-source\ 296}# + (#{syntax-object-expression\ 344}# + #{x\ 2039}#) + #{s\ 2052}#) + (cons (cons #{m\ 2040}# #{ms\ 2051}#) + (if #{rib\ 2028}# + (cons #{rib\ 2028}# + (cons 'shift #{s\ 2052}#)) + (cons 'shift #{s\ 2052}#))) + (#{syntax-object-module\ 348}# + #{x\ 2039}#))))))) + (if (vector? #{x\ 2039}#) + (begin + (let ((#{n\ 2064}# (vector-length #{x\ 2039}#))) + (begin + (let ((#{v\ 2066}# + (#{decorate-source\ 296}# + (make-vector #{n\ 2064}#) + #{x\ 2039}#))) + (letrec* + ((#{loop\ 2069}# + (lambda (#{i\ 2070}#) + (if (= #{i\ 2070}# #{n\ 2064}#) + (begin (if #f #f) #{v\ 2066}#) + (begin + (vector-set! + #{v\ 2066}# + #{i\ 2070}# + (#{rebuild-macro-output\ 2038}# + (vector-ref + #{x\ 2039}# + #{i\ 2070}#) + #{m\ 2040}#)) + (#{loop\ 2069}# + (1+ #{i\ 2070}#))))))) + (begin (#{loop\ 2069}# 0))))))) + (if (symbol? #{x\ 2039}#) + (syntax-violation + #f + "encountered raw symbol in macro output" + (#{source-wrap\ 444}# + #{e\ 2024}# + #{w\ 2026}# + (cdr #{w\ 2026}#) + #{mod\ 2029}#) + #{x\ 2039}#) + (#{decorate-source\ 296}# + #{x\ 2039}# + #{s\ 2027}#)))))))) + (begin + (#{rebuild-macro-output\ 2038}# + (#{p\ 2023}# + (#{source-wrap\ 444}# + #{e\ 2024}# + (#{anti-mark\ 414}# #{w\ 2026}#) + #{s\ 2027}# + #{mod\ 2029}#)) + (gensym "m")))))) + (#{chi-body\ 464}# + (lambda (#{body\ 2080}# + #{outer-form\ 2081}# + #{r\ 2082}# + #{w\ 2083}# + #{mod\ 2084}#) + (begin + (let ((#{r\ 2092}# + (cons '("placeholder" placeholder) #{r\ 2082}#))) + (begin + (let ((#{ribcage\ 2094}# + (#{make-ribcage\ 394}# '() '() '()))) + (begin + (let ((#{w\ 2097}# + (cons (car #{w\ 2083}#) + (cons #{ribcage\ 2094}# + (cdr #{w\ 2083}#))))) + (letrec* + ((#{parse\ 2109}# + (lambda (#{body\ 2110}# + #{ids\ 2111}# + #{labels\ 2112}# + #{var-ids\ 2113}# + #{vars\ 2114}# + #{vals\ 2115}# + #{bindings\ 2116}#) + (if (null? #{body\ 2110}#) + (syntax-violation + #f + "no expressions in body" + #{outer-form\ 2081}#) + (begin + (let ((#{e\ 2121}# + (cdr (car #{body\ 2110}#))) + (#{er\ 2122}# + (car (car #{body\ 2110}#)))) + (call-with-values + (lambda () + (#{syntax-type\ 454}# + #{e\ 2121}# + #{er\ 2122}# + '(()) + (#{source-annotation\ 357}# + #{er\ 2122}#) + #{ribcage\ 2094}# + #{mod\ 2084}# + #f)) + (lambda (#{type\ 2124}# + #{value\ 2125}# + #{e\ 2126}# + #{w\ 2127}# + #{s\ 2128}# + #{mod\ 2129}#) + (if (eqv? #{type\ 2124}# 'define-form) + (begin + (let ((#{id\ 2139}# + (#{wrap\ 442}# + #{value\ 2125}# + #{w\ 2127}# + #{mod\ 2129}#)) + (#{label\ 2140}# + (#{gen-label\ 389}#))) + (begin + (let ((#{var\ 2142}# + (#{gen-var\ 484}# + #{id\ 2139}#))) + (begin + (#{extend-ribcage!\ 418}# + #{ribcage\ 2094}# + #{id\ 2139}# + #{label\ 2140}#) + (#{parse\ 2109}# + (cdr #{body\ 2110}#) + (cons #{id\ 2139}# + #{ids\ 2111}#) + (cons #{label\ 2140}# + #{labels\ 2112}#) + (cons #{id\ 2139}# + #{var-ids\ 2113}#) + (cons #{var\ 2142}# + #{vars\ 2114}#) + (cons (cons #{er\ 2122}# + (#{wrap\ 442}# + #{e\ 2126}# + #{w\ 2127}# + #{mod\ 2129}#)) + #{vals\ 2115}#) + (cons (cons 'lexical + #{var\ 2142}#) + #{bindings\ 2116}#))))))) + (if (eqv? #{type\ 2124}# + 'define-syntax-form) + (begin + (let ((#{id\ 2147}# + (#{wrap\ 442}# + #{value\ 2125}# + #{w\ 2127}# + #{mod\ 2129}#)) + (#{label\ 2148}# + (#{gen-label\ 389}#))) + (begin + (#{extend-ribcage!\ 418}# + #{ribcage\ 2094}# + #{id\ 2147}# + #{label\ 2148}#) + (#{parse\ 2109}# + (cdr #{body\ 2110}#) + (cons #{id\ 2147}# + #{ids\ 2111}#) + (cons #{label\ 2148}# + #{labels\ 2112}#) + #{var-ids\ 2113}# + #{vars\ 2114}# + #{vals\ 2115}# + (cons (cons 'macro + (cons #{er\ 2122}# + (#{wrap\ 442}# + #{e\ 2126}# + #{w\ 2127}# + #{mod\ 2129}#))) + #{bindings\ 2116}#))))) + (if (eqv? #{type\ 2124}# + 'begin-form) + (let ((#{tmp\ 2151}# + #{e\ 2126}#)) + (let ((#{tmp\ 2152}# + ($sc-dispatch + #{tmp\ 2151}# + '(_ . each-any)))) + (if #{tmp\ 2152}# + (@apply + (lambda (#{e1\ 2154}#) + (#{parse\ 2109}# + (letrec* + ((#{f\ 2157}# + (lambda (#{forms\ 2158}#) + (if (null? #{forms\ 2158}#) + (cdr #{body\ 2110}#) + (cons (cons #{er\ 2122}# + (#{wrap\ 442}# + (car #{forms\ 2158}#) + #{w\ 2127}# + #{mod\ 2129}#)) + (#{f\ 2157}# + (cdr #{forms\ 2158}#))))))) + (begin + (#{f\ 2157}# + #{e1\ 2154}#))) + #{ids\ 2111}# + #{labels\ 2112}# + #{var-ids\ 2113}# + #{vars\ 2114}# + #{vals\ 2115}# + #{bindings\ 2116}#)) + #{tmp\ 2152}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 2151}#)))) + (if (eqv? #{type\ 2124}# + 'local-syntax-form) + (#{chi-local-syntax\ 466}# + #{value\ 2125}# + #{e\ 2126}# + #{er\ 2122}# + #{w\ 2127}# + #{s\ 2128}# + #{mod\ 2129}# + (lambda (#{forms\ 2161}# + #{er\ 2162}# + #{w\ 2163}# + #{s\ 2164}# + #{mod\ 2165}#) + (#{parse\ 2109}# + (letrec* + ((#{f\ 2173}# + (lambda (#{forms\ 2174}#) + (if (null? #{forms\ 2174}#) + (cdr #{body\ 2110}#) + (cons (cons #{er\ 2162}# + (#{wrap\ 442}# + (car #{forms\ 2174}#) + #{w\ 2163}# + #{mod\ 2165}#)) + (#{f\ 2173}# + (cdr #{forms\ 2174}#))))))) + (begin + (#{f\ 2173}# + #{forms\ 2161}#))) + #{ids\ 2111}# + #{labels\ 2112}# + #{var-ids\ 2113}# + #{vars\ 2114}# + #{vals\ 2115}# + #{bindings\ 2116}#))) + (if (null? #{ids\ 2111}#) + (#{build-sequence\ 330}# + #f + (map (lambda (#{x\ 2177}#) + (#{chi\ 456}# + (cdr #{x\ 2177}#) + (car #{x\ 2177}#) + '(()) + #{mod\ 2129}#)) + (cons (cons #{er\ 2122}# + (#{source-wrap\ 444}# + #{e\ 2126}# + #{w\ 2127}# + #{s\ 2128}# + #{mod\ 2129}#)) + (cdr #{body\ 2110}#)))) + (begin + (if (not (#{valid-bound-ids?\ 436}# + #{ids\ 2111}#)) + (syntax-violation + #f + "invalid or duplicate identifier in definition" + #{outer-form\ 2081}#)) + (letrec* + ((#{loop\ 2184}# + (lambda (#{bs\ 2185}# + #{er-cache\ 2186}# + #{r-cache\ 2187}#) + (if (not (null? #{bs\ 2185}#)) + (begin + (let ((#{b\ 2190}# + (car #{bs\ 2185}#))) + (if (eq? (car #{b\ 2190}#) + 'macro) + (begin + (let ((#{er\ 2193}# + (car (cdr #{b\ 2190}#)))) + (begin + (let ((#{r-cache\ 2195}# + (if (eq? #{er\ 2193}# + #{er-cache\ 2186}#) + #{r-cache\ 2187}# + (#{macros-only-env\ 368}# + #{er\ 2193}#)))) + (begin + (set-cdr! + #{b\ 2190}# + (#{eval-local-transformer\ 468}# + (#{chi\ 456}# + (cdr (cdr #{b\ 2190}#)) + #{r-cache\ 2195}# + '(()) + #{mod\ 2129}#) + #{mod\ 2129}#)) + (#{loop\ 2184}# + (cdr #{bs\ 2185}#) + #{er\ 2193}# + #{r-cache\ 2195}#)))))) + (#{loop\ 2184}# + (cdr #{bs\ 2185}#) + #{er-cache\ 2186}# + #{r-cache\ 2187}#)))))))) + (begin + (#{loop\ 2184}# + #{bindings\ 2116}# + #f + #f))) + (set-cdr! + #{r\ 2092}# + (#{extend-env\ 364}# + #{labels\ 2112}# + #{bindings\ 2116}# + (cdr #{r\ 2092}#))) + (#{build-letrec\ 336}# + #f + #t + (reverse + (map syntax->datum + #{var-ids\ 2113}#)) + (reverse #{vars\ 2114}#) + (map (lambda (#{x\ 2198}#) + (#{chi\ 456}# + (cdr #{x\ 2198}#) + (car #{x\ 2198}#) + '(()) + #{mod\ 2129}#)) + (reverse + #{vals\ 2115}#)) + (#{build-sequence\ 330}# + #f + (map (lambda (#{x\ 2202}#) + (#{chi\ 456}# + (cdr #{x\ 2202}#) + (car #{x\ 2202}#) + '(()) + #{mod\ 2129}#)) + (cons (cons #{er\ 2122}# + (#{source-wrap\ 444}# + #{e\ 2126}# + #{w\ 2127}# + #{s\ 2128}# + #{mod\ 2129}#)) + (cdr #{body\ 2110}#))))))))))))))))))) + (begin + (#{parse\ 2109}# + (map (lambda (#{x\ 2117}#) + (cons #{r\ 2092}# + (#{wrap\ 442}# + #{x\ 2117}# + #{w\ 2097}# + #{mod\ 2084}#))) + #{body\ 2080}#) + '() + '() + '() + '() + '() + '()))))))))))) + (#{chi-local-syntax\ 466}# + (lambda (#{rec?\ 2205}# + #{e\ 2206}# + #{r\ 2207}# + #{w\ 2208}# + #{s\ 2209}# + #{mod\ 2210}# + #{k\ 2211}#) + (let ((#{tmp\ 2219}# #{e\ 2206}#)) + (let ((#{tmp\ 2220}# + ($sc-dispatch + #{tmp\ 2219}# + '(_ #(each (any any)) any . each-any)))) + (if #{tmp\ 2220}# + (@apply + (lambda (#{id\ 2225}# + #{val\ 2226}# + #{e1\ 2227}# + #{e2\ 2228}#) + (begin + (let ((#{ids\ 2230}# #{id\ 2225}#)) + (if (not (#{valid-bound-ids?\ 436}# #{ids\ 2230}#)) + (syntax-violation + #f + "duplicate bound keyword" + #{e\ 2206}#) + (begin + (let ((#{labels\ 2233}# + (#{gen-labels\ 391}# #{ids\ 2230}#))) + (begin + (let ((#{new-w\ 2235}# + (#{make-binding-wrap\ 420}# + #{ids\ 2230}# + #{labels\ 2233}# + #{w\ 2208}#))) + (#{k\ 2211}# + (cons #{e1\ 2227}# #{e2\ 2228}#) + (#{extend-env\ 364}# + #{labels\ 2233}# + (begin + (let ((#{w\ 2239}# + (if #{rec?\ 2205}# + #{new-w\ 2235}# + #{w\ 2208}#)) + (#{trans-r\ 2240}# + (#{macros-only-env\ 368}# + #{r\ 2207}#))) + (map (lambda (#{x\ 2241}#) + (cons 'macro + (#{eval-local-transformer\ 468}# + (#{chi\ 456}# + #{x\ 2241}# + #{trans-r\ 2240}# + #{w\ 2239}# + #{mod\ 2210}#) + #{mod\ 2210}#))) + #{val\ 2226}#))) + #{r\ 2207}#) + #{new-w\ 2235}# + #{s\ 2209}# + #{mod\ 2210}#))))))))) + #{tmp\ 2220}#) + (let ((#{_\ 2246}# #{tmp\ 2219}#)) + (syntax-violation + #f + "bad local syntax definition" + (#{source-wrap\ 444}# + #{e\ 2206}# + #{w\ 2208}# + #{s\ 2209}# + #{mod\ 2210}#)))))))) + (#{eval-local-transformer\ 468}# + (lambda (#{expanded\ 2247}# #{mod\ 2248}#) + (begin + (let ((#{p\ 2252}# + (#{local-eval-hook\ 289}# + #{expanded\ 2247}# + #{mod\ 2248}#))) + (if (procedure? #{p\ 2252}#) + #{p\ 2252}# + (syntax-violation + #f + "nonprocedure transformer" + #{p\ 2252}#)))))) + (#{chi-void\ 470}# + (lambda () (#{build-void\ 300}# #f))) + (#{ellipsis?\ 472}# + (lambda (#{x\ 2254}#) + (if (#{nonsymbol-id?\ 374}# #{x\ 2254}#) + (#{free-id=?\ 432}# + #{x\ 2254}# + '#(syntax-object + ... + ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("i2255")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile))) + #f))) + (#{lambda-formals\ 474}# + (lambda (#{orig-args\ 2258}#) + (letrec* + ((#{req\ 2261}# + (lambda (#{args\ 2264}# #{rreq\ 2265}#) + (let ((#{tmp\ 2268}# #{args\ 2264}#)) + (let ((#{tmp\ 2269}# ($sc-dispatch #{tmp\ 2268}# '()))) + (if #{tmp\ 2269}# + (@apply + (lambda () + (#{check\ 2263}# (reverse #{rreq\ 2265}#) #f)) + #{tmp\ 2269}#) + (let ((#{tmp\ 2270}# + ($sc-dispatch #{tmp\ 2268}# '(any . any)))) + (if (if #{tmp\ 2270}# + (@apply + (lambda (#{a\ 2273}# #{b\ 2274}#) + (#{id?\ 376}# #{a\ 2273}#)) + #{tmp\ 2270}#) + #f) + (@apply + (lambda (#{a\ 2277}# #{b\ 2278}#) + (#{req\ 2261}# + #{b\ 2278}# + (cons #{a\ 2277}# #{rreq\ 2265}#))) + #{tmp\ 2270}#) + (let ((#{tmp\ 2279}# (list #{tmp\ 2268}#))) + (if (if #{tmp\ 2279}# + (@apply + (lambda (#{r\ 2281}#) + (#{id?\ 376}# #{r\ 2281}#)) + #{tmp\ 2279}#) + #f) + (@apply + (lambda (#{r\ 2283}#) + (#{check\ 2263}# + (reverse #{rreq\ 2265}#) + #{r\ 2283}#)) + #{tmp\ 2279}#) + (let ((#{else\ 2285}# #{tmp\ 2268}#)) + (syntax-violation + 'lambda + "invalid argument list" + #{orig-args\ 2258}# + #{args\ 2264}#))))))))))) + (#{check\ 2263}# + (lambda (#{req\ 2286}# #{rest\ 2287}#) + (if (#{distinct-bound-ids?\ 438}# + (if #{rest\ 2287}# + (cons #{rest\ 2287}# #{req\ 2286}#) + #{req\ 2286}#)) + (values #{req\ 2286}# #f #{rest\ 2287}# #f) + (syntax-violation + 'lambda + "duplicate identifier in argument list" + #{orig-args\ 2258}#))))) + (begin (#{req\ 2261}# #{orig-args\ 2258}# '()))))) + (#{chi-simple-lambda\ 476}# + (lambda (#{e\ 2293}# + #{r\ 2294}# + #{w\ 2295}# + #{s\ 2296}# + #{mod\ 2297}# + #{req\ 2298}# + #{rest\ 2299}# + #{meta\ 2300}# + #{body\ 2301}#) + (begin + (let ((#{ids\ 2313}# + (if #{rest\ 2299}# + (append #{req\ 2298}# (list #{rest\ 2299}#)) + #{req\ 2298}#))) + (begin + (let ((#{vars\ 2315}# + (map #{gen-var\ 484}# #{ids\ 2313}#))) + (begin + (let ((#{labels\ 2317}# + (#{gen-labels\ 391}# #{ids\ 2313}#))) + (#{build-simple-lambda\ 320}# + #{s\ 2296}# + (map syntax->datum #{req\ 2298}#) + (if #{rest\ 2299}# + (syntax->datum #{rest\ 2299}#) + #f) + #{vars\ 2315}# + #{meta\ 2300}# + (#{chi-body\ 464}# + #{body\ 2301}# + (#{source-wrap\ 444}# + #{e\ 2293}# + #{w\ 2295}# + #{s\ 2296}# + #{mod\ 2297}#) + (#{extend-var-env\ 366}# + #{labels\ 2317}# + #{vars\ 2315}# + #{r\ 2294}#) + (#{make-binding-wrap\ 420}# + #{ids\ 2313}# + #{labels\ 2317}# + #{w\ 2295}#) + #{mod\ 2297}#)))))))))) + (#{lambda*-formals\ 478}# + (lambda (#{orig-args\ 2320}#) + (letrec* + ((#{req\ 2323}# + (lambda (#{args\ 2332}# #{rreq\ 2333}#) + (let ((#{tmp\ 2336}# #{args\ 2332}#)) + (let ((#{tmp\ 2337}# ($sc-dispatch #{tmp\ 2336}# '()))) + (if #{tmp\ 2337}# + (@apply + (lambda () + (#{check\ 2331}# + (reverse #{rreq\ 2333}#) + '() + #f + '())) + #{tmp\ 2337}#) + (let ((#{tmp\ 2338}# + ($sc-dispatch #{tmp\ 2336}# '(any . any)))) + (if (if #{tmp\ 2338}# + (@apply + (lambda (#{a\ 2341}# #{b\ 2342}#) + (#{id?\ 376}# #{a\ 2341}#)) + #{tmp\ 2338}#) + #f) + (@apply + (lambda (#{a\ 2345}# #{b\ 2346}#) + (#{req\ 2323}# + #{b\ 2346}# + (cons #{a\ 2345}# #{rreq\ 2333}#))) + #{tmp\ 2338}#) + (let ((#{tmp\ 2347}# + ($sc-dispatch #{tmp\ 2336}# '(any . any)))) + (if (if #{tmp\ 2347}# + (@apply + (lambda (#{a\ 2350}# #{b\ 2351}#) + (eq? (syntax->datum #{a\ 2350}#) + #:optional)) + #{tmp\ 2347}#) + #f) + (@apply + (lambda (#{a\ 2354}# #{b\ 2355}#) + (#{opt\ 2325}# + #{b\ 2355}# + (reverse #{rreq\ 2333}#) + '())) + #{tmp\ 2347}#) + (let ((#{tmp\ 2356}# ($sc-dispatch - #{tmp\ 3706}# - '(any any)))) - (if (if #{tmp\ 3707}# + #{tmp\ 2336}# + '(any . any)))) + (if (if #{tmp\ 2356}# (@apply - (lambda (#{x\ 3710}# #{dots\ 3711}#) - (#{ellipsis?\ 476}# - #{dots\ 3711}#)) - #{tmp\ 3707}#) + (lambda (#{a\ 2359}# #{b\ 2360}#) + (eq? (syntax->datum #{a\ 2359}#) + #:key)) + #{tmp\ 2356}#) #f) (@apply - (lambda (#{x\ 3714}# #{dots\ 3715}#) - (call-with-values - (lambda () - (#{cvt\ 3680}# - #{x\ 3714}# - (#{fx+\ 283}# #{n\ 3696}# 1) - #{ids\ 3697}#)) - (lambda (#{p\ 3716}# #{ids\ 3717}#) - (values - (if (eq? #{p\ 3716}# 'any) - 'each-any - (vector 'each #{p\ 3716}#)) - #{ids\ 3717}#)))) - #{tmp\ 3707}#) - (let ((#{tmp\ 3720}# + (lambda (#{a\ 2363}# #{b\ 2364}#) + (#{key\ 2327}# + #{b\ 2364}# + (reverse #{rreq\ 2333}#) + '() + '())) + #{tmp\ 2356}#) + (let ((#{tmp\ 2365}# ($sc-dispatch - #{tmp\ 3706}# - '(any any . each-any)))) - (if (if #{tmp\ 3720}# + #{tmp\ 2336}# + '(any any)))) + (if (if #{tmp\ 2365}# (@apply - (lambda (#{x\ 3724}# - #{dots\ 3725}# - #{ys\ 3726}#) - (#{ellipsis?\ 476}# - #{dots\ 3725}#)) - #{tmp\ 3720}#) + (lambda (#{a\ 2368}# #{b\ 2369}#) + (eq? (syntax->datum + #{a\ 2368}#) + #:rest)) + #{tmp\ 2365}#) #f) (@apply - (lambda (#{x\ 3730}# - #{dots\ 3731}# - #{ys\ 3732}#) - (call-with-values - (lambda () - (#{cvt*\ 3678}# - #{ys\ 3732}# - #{n\ 3696}# - #{ids\ 3697}#)) - (lambda (#{ys\ 3734}# - #{ids\ 3735}#) - (call-with-values - (lambda () - (#{cvt\ 3680}# - #{x\ 3730}# - (1+ #{n\ 3696}#) - #{ids\ 3735}#)) - (lambda (#{x\ 3738}# - #{ids\ 3739}#) - (values - (vector - 'each+ - #{x\ 3738}# - (reverse #{ys\ 3734}#) - '()) - #{ids\ 3739}#)))))) - #{tmp\ 3720}#) - (let ((#{tmp\ 3743}# - ($sc-dispatch - #{tmp\ 3706}# - '(any . any)))) - (if #{tmp\ 3743}# - (@apply - (lambda (#{x\ 3746}# #{y\ 3747}#) - (call-with-values - (lambda () - (#{cvt\ 3680}# - #{y\ 3747}# - #{n\ 3696}# - #{ids\ 3697}#)) - (lambda (#{y\ 3748}# - #{ids\ 3749}#) - (call-with-values - (lambda () - (#{cvt\ 3680}# - #{x\ 3746}# - #{n\ 3696}# - #{ids\ 3749}#)) - (lambda (#{x\ 3752}# - #{ids\ 3753}#) - (values - (cons #{x\ 3752}# - #{y\ 3748}#) - #{ids\ 3753}#)))))) - #{tmp\ 3743}#) - (let ((#{tmp\ 3756}# - ($sc-dispatch - #{tmp\ 3706}# - '()))) - (if #{tmp\ 3756}# + (lambda (#{a\ 2372}# #{b\ 2373}#) + (#{rest\ 2329}# + #{b\ 2373}# + (reverse #{rreq\ 2333}#) + '() + '())) + #{tmp\ 2365}#) + (let ((#{tmp\ 2374}# + (list #{tmp\ 2336}#))) + (if (if #{tmp\ 2374}# (@apply - (lambda () - (values '() #{ids\ 3697}#)) - #{tmp\ 3756}#) - (let ((#{tmp\ 3757}# - ($sc-dispatch - #{tmp\ 3706}# - '#(vector - each-any)))) - (if #{tmp\ 3757}# - (@apply - (lambda (#{x\ 3759}#) - (call-with-values - (lambda () - (#{cvt\ 3680}# - #{x\ 3759}# - #{n\ 3696}# - #{ids\ 3697}#)) - (lambda (#{p\ 3761}# - #{ids\ 3762}#) - (values - (vector - 'vector - #{p\ 3761}#) - #{ids\ 3762}#)))) - #{tmp\ 3757}#) - (let ((#{x\ 3766}# - #{tmp\ 3706}#)) - (values - (vector - 'atom - (#{strip\ 486}# - #{p\ 3695}# - '(()))) - #{ids\ 3697}#))))))))))))))))) - (begin (#{cvt\ 3680}# #{pattern\ 3673}# 0 '()))))) - (#{build-dispatch-call\ 3668}# - (lambda (#{pvars\ 3768}# - #{exp\ 3769}# - #{y\ 3770}# - #{r\ 3771}# - #{mod\ 3772}#) - (begin - (map cdr #{pvars\ 3768}#) - (let ((#{ids\ 3780}# (map car #{pvars\ 3768}#))) - (begin - (let ((#{labels\ 3784}# - (#{gen-labels\ 395}# #{ids\ 3780}#)) - (#{new-vars\ 3785}# - (map #{gen-var\ 488}# #{ids\ 3780}#))) - (#{build-application\ 306}# - #f - (#{build-primref\ 330}# #f 'apply) - (list (#{build-simple-lambda\ 324}# - #f - (map syntax->datum #{ids\ 3780}#) - #f - #{new-vars\ 3785}# - '() - (#{chi\ 460}# - #{exp\ 3769}# - (#{extend-env\ 368}# - #{labels\ 3784}# - (map (lambda (#{var\ 3789}# - #{level\ 3790}#) - (cons 'syntax - (cons #{var\ 3789}# - #{level\ 3790}#))) - #{new-vars\ 3785}# - (map cdr #{pvars\ 3768}#)) - #{r\ 3771}#) - (#{make-binding-wrap\ 424}# - #{ids\ 3780}# - #{labels\ 3784}# - '(())) - #{mod\ 3772}#)) - #{y\ 3770}#)))))))) - (#{gen-clause\ 3670}# - (lambda (#{x\ 3796}# - #{keys\ 3797}# - #{clauses\ 3798}# - #{r\ 3799}# - #{pat\ 3800}# - #{fender\ 3801}# - #{exp\ 3802}# - #{mod\ 3803}#) - (call-with-values - (lambda () - (#{convert-pattern\ 3666}# - #{pat\ 3800}# - #{keys\ 3797}#)) - (lambda (#{p\ 3812}# #{pvars\ 3813}#) - (if (not (#{distinct-bound-ids?\ 442}# - (map car #{pvars\ 3813}#))) - (syntax-violation - 'syntax-case - "duplicate pattern variable" - #{pat\ 3800}#) - (if (not (and-map - (lambda (#{x\ 3820}#) - (not (#{ellipsis?\ 476}# - (car #{x\ 3820}#)))) - #{pvars\ 3813}#)) - (syntax-violation - 'syntax-case - "misplaced ellipsis" - #{pat\ 3800}#) - (begin - (let ((#{y\ 3824}# (#{gen-var\ 488}# 'tmp))) - (#{build-application\ 306}# - #f - (#{build-simple-lambda\ 324}# - #f - (list 'tmp) - #f - (list #{y\ 3824}#) - '() - (begin - (let ((#{y\ 3828}# - (#{build-lexical-reference\ 312}# - 'value - #f - 'tmp - #{y\ 3824}#))) - (#{build-conditional\ 308}# - #f - (let ((#{tmp\ 3831}# - #{fender\ 3801}#)) - (let ((#{tmp\ 3832}# - ($sc-dispatch - #{tmp\ 3831}# - '#(atom #t)))) - (if #{tmp\ 3832}# - (@apply - (lambda () #{y\ 3828}#) - #{tmp\ 3832}#) - (let ((#{_\ 3834}# - #{tmp\ 3831}#)) - (#{build-conditional\ 308}# - #f - #{y\ 3828}# - (#{build-dispatch-call\ 3668}# - #{pvars\ 3813}# - #{fender\ 3801}# - #{y\ 3828}# - #{r\ 3799}# - #{mod\ 3803}#) - (#{build-data\ 332}# - #f - #f)))))) - (#{build-dispatch-call\ 3668}# - #{pvars\ 3813}# - #{exp\ 3802}# - #{y\ 3828}# - #{r\ 3799}# - #{mod\ 3803}#) - (#{gen-syntax-case\ 3672}# - #{x\ 3796}# - #{keys\ 3797}# - #{clauses\ 3798}# - #{r\ 3799}# - #{mod\ 3803}#))))) - (list (if (eq? #{p\ 3812}# 'any) - (#{build-application\ 306}# - #f - (#{build-primref\ 330}# #f 'list) - (list #{x\ 3796}#)) - (#{build-application\ 306}# - #f - (#{build-primref\ 330}# - #f - '$sc-dispatch) - (list #{x\ 3796}# - (#{build-data\ 332}# - #f - #{p\ 3812}#)))))))))))))) - (#{gen-syntax-case\ 3672}# - (lambda (#{x\ 3842}# - #{keys\ 3843}# - #{clauses\ 3844}# - #{r\ 3845}# - #{mod\ 3846}#) - (if (null? #{clauses\ 3844}#) - (#{build-application\ 306}# - #f - (#{build-primref\ 330}# #f 'syntax-violation) - (list (#{build-data\ 332}# #f #f) - (#{build-data\ 332}# - #f - "source expression failed to match any pattern") - #{x\ 3842}#)) - (let ((#{tmp\ 3856}# (car #{clauses\ 3844}#))) - (let ((#{tmp\ 3857}# - ($sc-dispatch #{tmp\ 3856}# '(any any)))) - (if #{tmp\ 3857}# - (@apply - (lambda (#{pat\ 3860}# #{exp\ 3861}#) - (if (if (#{id?\ 380}# #{pat\ 3860}#) - (and-map - (lambda (#{x\ 3864}#) - (not (#{free-id=?\ 436}# - #{pat\ 3860}# - #{x\ 3864}#))) - (cons '#(syntax-object - ... + (lambda (#{r\ 2376}#) + (#{id?\ 376}# #{r\ 2376}#)) + #{tmp\ 2374}#) + #f) + (@apply + (lambda (#{r\ 2378}#) + (#{rest\ 2329}# + #{r\ 2378}# + (reverse #{rreq\ 2333}#) + '() + '())) + #{tmp\ 2374}#) + (let ((#{else\ 2380}# + #{tmp\ 2336}#)) + (syntax-violation + 'lambda* + "invalid argument list" + #{orig-args\ 2320}# + #{args\ 2332}#))))))))))))))))) + (#{opt\ 2325}# + (lambda (#{args\ 2381}# #{req\ 2382}# #{ropt\ 2383}#) + (let ((#{tmp\ 2387}# #{args\ 2381}#)) + (let ((#{tmp\ 2388}# ($sc-dispatch #{tmp\ 2387}# '()))) + (if #{tmp\ 2388}# + (@apply + (lambda () + (#{check\ 2331}# + #{req\ 2382}# + (reverse #{ropt\ 2383}#) + #f + '())) + #{tmp\ 2388}#) + (let ((#{tmp\ 2389}# + ($sc-dispatch #{tmp\ 2387}# '(any . any)))) + (if (if #{tmp\ 2389}# + (@apply + (lambda (#{a\ 2392}# #{b\ 2393}#) + (#{id?\ 376}# #{a\ 2392}#)) + #{tmp\ 2389}#) + #f) + (@apply + (lambda (#{a\ 2396}# #{b\ 2397}#) + (#{opt\ 2325}# + #{b\ 2397}# + #{req\ 2382}# + (cons (cons #{a\ 2396}# + '(#(syntax-object + #f ((top) #(ribcage - #(pat exp) + #(a b) #((top) (top)) - #("i3858" "i3859")) + #("i2394" "i2395")) #(ribcage () () ()) #(ribcage - #(x keys clauses r mod) - #((top) - (top) - (top) - (top) - (top)) - #("i3847" - "i3848" - "i3849" - "i3850" - "i3851")) + #(args req ropt) + #((top) (top) (top)) + #("i2384" + "i2385" + "i2386")) #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("i3671" - "i3669" - "i3667" - "i3665")) + (check rest key opt req) + ((top) + (top) + (top) + (top) + (top)) + ("i2330" + "i2328" + "i2326" + "i2324" + "i2322")) + #(ribcage + #(orig-args) + #((top)) + #("i2321")) #(ribcage (lambda-var-list gen-var @@ -12868,9 +7406,7 @@ (top) (top) (top)) - ("i489" - "i487" - "i485" + ("i485" "i483" "i481" "i479" @@ -12903,14 +7439,14 @@ "i425" "i423" "i421" - "i420" "i419" "i417" "i416" "i415" - "i414" "i413" + "i412" "i411" + "i410" "i409" "i407" "i405" @@ -12918,33 +7454,33 @@ "i401" "i399" "i397" - "i394" - "i392" - "i391" + "i395" + "i393" "i390" - "i389" "i388" "i387" "i386" "i385" "i384" + "i383" "i382" "i381" - "i379" + "i380" + "i378" "i377" "i375" "i373" "i371" "i369" "i367" - "i366" "i365" - "i364" "i363" "i362" + "i361" "i360" "i359" - "i357" + "i358" + "i356" "i355" "i353" "i351" @@ -12976,12 +7512,14 @@ "i299" "i297" "i295" - "i294" - "i292" + "i293" + "i291" "i290" "i288" "i286" + "i285" "i284" + "i283" "i282" "i280" "i278" @@ -13014,1567 +7552,6930 @@ "i40" "i39" "i37"))) - (hygiene guile)) - #{keys\ 3843}#)) - #f) - (if (#{free-id=?\ 436}# - '#(syntax-object - pad - ((top) - #(ribcage - #(pat exp) - #((top) (top)) - #("i3858" "i3859")) - #(ribcage () () ()) - #(ribcage - #(x keys clauses r mod) - #((top) (top) (top) (top) (top)) - #("i3847" - "i3848" - "i3849" - "i3850" - "i3851")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("i3671" - "i3669" - "i3667" - "i3665")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile)) - '#(syntax-object - _ - ((top) - #(ribcage - #(pat exp) - #((top) (top)) - #("i3858" "i3859")) - #(ribcage () () ()) - #(ribcage - #(x keys clauses r mod) - #((top) (top) (top) (top) (top)) - #("i3847" - "i3848" - "i3849" - "i3850" - "i3851")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("i3671" - "i3669" - "i3667" - "i3665")) - #(ribcage - (lambda-var-list - gen-var - strip - chi-lambda-case - lambda*-formals - chi-simple-lambda - lambda-formals - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-body - chi-macro - chi-application - chi-expr - chi - 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 - 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-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i489" - "i487" - "i485" - "i483" - "i481" - "i479" - "i477" - "i475" - "i473" - "i471" - "i469" - "i467" - "i465" - "i463" - "i461" - "i459" - "i457" - "i455" - "i453" - "i451" - "i449" - "i447" - "i445" - "i443" - "i441" - "i439" - "i437" - "i435" - "i433" - "i431" - "i429" - "i427" - "i425" - "i423" - "i421" - "i420" - "i419" - "i417" - "i416" - "i415" - "i414" - "i413" - "i411" - "i409" - "i407" - "i405" - "i403" - "i401" - "i399" - "i397" - "i394" - "i392" - "i391" - "i390" - "i389" - "i388" - "i387" - "i386" - "i385" - "i384" - "i382" - "i381" - "i379" - "i377" - "i375" - "i373" - "i371" - "i369" - "i367" - "i366" - "i365" - "i364" - "i363" - "i362" - "i360" - "i359" - "i357" - "i355" - "i353" - "i351" - "i349" - "i347" - "i345" - "i343" - "i341" - "i339" - "i337" - "i335" - "i333" - "i331" - "i329" - "i327" - "i325" - "i323" - "i321" - "i319" - "i317" - "i315" - "i313" - "i311" - "i309" - "i307" - "i305" - "i303" - "i301" - "i299" - "i297" - "i295" - "i294" - "i292" - "i290" - "i288" - "i286" - "i284" - "i282" - "i280" - "i278" - "i276" - "i273" - "i271" - "i269" - "i267" - "i265" - "i263" - "i261" - "i259" - "i257" - "i255" - "i253" - "i251" - "i249" - "i247" - "i245" - "i243" - "i241" - "i239")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors - and-map*) - ((top) (top) (top) (top)) - ("i41" "i40" "i39" "i37"))) - (hygiene guile))) - (#{chi\ 460}# - #{exp\ 3861}# - #{r\ 3845}# - '(()) - #{mod\ 3846}#) - (begin - (let ((#{labels\ 3869}# - (list (#{gen-label\ 393}#))) - (#{var\ 3870}# - (#{gen-var\ 488}# - #{pat\ 3860}#))) - (#{build-application\ 306}# - #f - (#{build-simple-lambda\ 324}# - #f - (list (syntax->datum - #{pat\ 3860}#)) - #f - (list #{var\ 3870}#) - '() - (#{chi\ 460}# - #{exp\ 3861}# - (#{extend-env\ 368}# - #{labels\ 3869}# - (list (cons 'syntax - (cons #{var\ 3870}# - 0))) - #{r\ 3845}#) - (#{make-binding-wrap\ 424}# - (list #{pat\ 3860}#) - #{labels\ 3869}# - '(())) - #{mod\ 3846}#)) - (list #{x\ 3842}#))))) - (#{gen-clause\ 3670}# - #{x\ 3842}# - #{keys\ 3843}# - (cdr #{clauses\ 3844}#) - #{r\ 3845}# - #{pat\ 3860}# - #t - #{exp\ 3861}# - #{mod\ 3846}#))) - #{tmp\ 3857}#) - (let ((#{tmp\ 3876}# - ($sc-dispatch - #{tmp\ 3856}# - '(any any any)))) - (if #{tmp\ 3876}# - (@apply - (lambda (#{pat\ 3880}# - #{fender\ 3881}# - #{exp\ 3882}#) - (#{gen-clause\ 3670}# - #{x\ 3842}# - #{keys\ 3843}# - (cdr #{clauses\ 3844}#) - #{r\ 3845}# - #{pat\ 3880}# - #{fender\ 3881}# - #{exp\ 3882}# - #{mod\ 3846}#)) - #{tmp\ 3876}#) - (let ((#{_\ 3884}# #{tmp\ 3856}#)) - (syntax-violation - 'syntax-case - "invalid clause" - (car #{clauses\ 3844}#)))))))))))) - (begin - (lambda (#{e\ 3885}# - #{r\ 3886}# - #{w\ 3887}# - #{s\ 3888}# - #{mod\ 3889}#) - (begin - (let ((#{e\ 3896}# - (#{source-wrap\ 448}# - #{e\ 3885}# - #{w\ 3887}# - #{s\ 3888}# - #{mod\ 3889}#))) - (let ((#{tmp\ 3897}# #{e\ 3896}#)) - (let ((#{tmp\ 3898}# - ($sc-dispatch - #{tmp\ 3897}# - '(_ any each-any . each-any)))) - (if #{tmp\ 3898}# - (@apply - (lambda (#{val\ 3902}# - #{key\ 3903}# - #{m\ 3904}#) - (if (and-map - (lambda (#{x\ 3905}#) - (if (#{id?\ 380}# #{x\ 3905}#) - (not (#{ellipsis?\ 476}# - #{x\ 3905}#)) - #f)) - #{key\ 3903}#) - (begin - (let ((#{x\ 3911}# - (#{gen-var\ 488}# 'tmp))) - (#{build-application\ 306}# - #{s\ 3888}# - (#{build-simple-lambda\ 324}# - #f - (list 'tmp) - #f - (list #{x\ 3911}#) - '() - (#{gen-syntax-case\ 3672}# - (#{build-lexical-reference\ 312}# - 'value - #f - 'tmp - #{x\ 3911}#) - #{key\ 3903}# - #{m\ 3904}# - #{r\ 3886}# - #{mod\ 3889}#)) - (list (#{chi\ 460}# - #{val\ 3902}# - #{r\ 3886}# - '(()) - #{mod\ 3889}#))))) - (syntax-violation - 'syntax-case - "invalid literals list" - #{e\ 3896}#))) - #{tmp\ 3898}#) - (syntax-violation - #f - "source expression failed to match any pattern" - #{tmp\ 3897}#)))))))))) - (set! macroexpand - (lambda* - (#{x\ 3917}# - #:optional - (#{m\ 3919}# 'e) - (#{esew\ 3921}# '(eval))) - (#{chi-top-sequence\ 452}# - (list #{x\ 3917}#) - '() - '((top)) - #f - #{m\ 3919}# - #{esew\ 3921}# - (cons 'hygiene (module-name (current-module)))))) - (set! identifier? - (lambda (#{x\ 3925}#) - (#{nonsymbol-id?\ 378}# #{x\ 3925}#))) - (set! datum->syntax - (lambda (#{id\ 3927}# #{datum\ 3928}#) - (#{make-syntax-object\ 344}# - #{datum\ 3928}# - (#{syntax-object-wrap\ 350}# #{id\ 3927}#) - (#{syntax-object-module\ 352}# #{id\ 3927}#)))) - (set! syntax->datum - (lambda (#{x\ 3931}#) - (#{strip\ 486}# #{x\ 3931}# '(())))) - (set! syntax-source - (lambda (#{x\ 3934}#) - (#{source-annotation\ 361}# #{x\ 3934}#))) - (set! generate-temporaries - (lambda (#{ls\ 3936}#) - (begin + (hygiene guile)))) + #{ropt\ 2383}#))) + #{tmp\ 2389}#) + (let ((#{tmp\ 2398}# + ($sc-dispatch + #{tmp\ 2387}# + '((any any) . any)))) + (if (if #{tmp\ 2398}# + (@apply + (lambda (#{a\ 2402}# + #{init\ 2403}# + #{b\ 2404}#) + (#{id?\ 376}# #{a\ 2402}#)) + #{tmp\ 2398}#) + #f) + (@apply + (lambda (#{a\ 2408}# + #{init\ 2409}# + #{b\ 2410}#) + (#{opt\ 2325}# + #{b\ 2410}# + #{req\ 2382}# + (cons (list #{a\ 2408}# #{init\ 2409}#) + #{ropt\ 2383}#))) + #{tmp\ 2398}#) + (let ((#{tmp\ 2411}# + ($sc-dispatch + #{tmp\ 2387}# + '(any . any)))) + (if (if #{tmp\ 2411}# + (@apply + (lambda (#{a\ 2414}# #{b\ 2415}#) + (eq? (syntax->datum #{a\ 2414}#) + #:key)) + #{tmp\ 2411}#) + #f) + (@apply + (lambda (#{a\ 2418}# #{b\ 2419}#) + (#{key\ 2327}# + #{b\ 2419}# + #{req\ 2382}# + (reverse #{ropt\ 2383}#) + '())) + #{tmp\ 2411}#) + (let ((#{tmp\ 2420}# + ($sc-dispatch + #{tmp\ 2387}# + '(any any)))) + (if (if #{tmp\ 2420}# + (@apply + (lambda (#{a\ 2423}# #{b\ 2424}#) + (eq? (syntax->datum + #{a\ 2423}#) + #:rest)) + #{tmp\ 2420}#) + #f) + (@apply + (lambda (#{a\ 2427}# #{b\ 2428}#) + (#{rest\ 2329}# + #{b\ 2428}# + #{req\ 2382}# + (reverse #{ropt\ 2383}#) + '())) + #{tmp\ 2420}#) + (let ((#{tmp\ 2429}# + (list #{tmp\ 2387}#))) + (if (if #{tmp\ 2429}# + (@apply + (lambda (#{r\ 2431}#) + (#{id?\ 376}# #{r\ 2431}#)) + #{tmp\ 2429}#) + #f) + (@apply + (lambda (#{r\ 2433}#) + (#{rest\ 2329}# + #{r\ 2433}# + #{req\ 2382}# + (reverse #{ropt\ 2383}#) + '())) + #{tmp\ 2429}#) + (let ((#{else\ 2435}# + #{tmp\ 2387}#)) + (syntax-violation + 'lambda* + "invalid optional argument list" + #{orig-args\ 2320}# + #{args\ 2381}#))))))))))))))))) + (#{key\ 2327}# + (lambda (#{args\ 2436}# + #{req\ 2437}# + #{opt\ 2438}# + #{rkey\ 2439}#) + (let ((#{tmp\ 2444}# #{args\ 2436}#)) + (let ((#{tmp\ 2445}# ($sc-dispatch #{tmp\ 2444}# '()))) + (if #{tmp\ 2445}# + (@apply + (lambda () + (#{check\ 2331}# + #{req\ 2437}# + #{opt\ 2438}# + #f + (cons #f (reverse #{rkey\ 2439}#)))) + #{tmp\ 2445}#) + (let ((#{tmp\ 2446}# + ($sc-dispatch #{tmp\ 2444}# '(any . any)))) + (if (if #{tmp\ 2446}# + (@apply + (lambda (#{a\ 2449}# #{b\ 2450}#) + (#{id?\ 376}# #{a\ 2449}#)) + #{tmp\ 2446}#) + #f) + (@apply + (lambda (#{a\ 2453}# #{b\ 2454}#) + (let ((#{tmp\ 2456}# + (symbol->keyword + (syntax->datum #{a\ 2453}#)))) + (let ((#{k\ 2458}# #{tmp\ 2456}#)) + (#{key\ 2327}# + #{b\ 2454}# + #{req\ 2437}# + #{opt\ 2438}# + (cons (cons #{k\ 2458}# + (cons #{a\ 2453}# + '(#(syntax-object + #f + ((top) + #(ribcage + () + () + ()) + #(ribcage + #(k) + #((top)) + #("i2457")) + #(ribcage + #(a b) + #((top) (top)) + #("i2451" + "i2452")) + #(ribcage + () + () + ()) + #(ribcage + #(args + req + opt + rkey) + #((top) + (top) + (top) + (top)) + #("i2440" + "i2441" + "i2442" + "i2443")) + #(ribcage + (check rest + key + opt + req) + ((top) + (top) + (top) + (top) + (top)) + ("i2330" + "i2328" + "i2326" + "i2324" + "i2322")) + #(ribcage + #(orig-args) + #((top)) + #("i2321")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) + (top) + (top) + (top)) + ("i41" + "i40" + "i39" + "i37"))) + (hygiene guile))))) + #{rkey\ 2439}#))))) + #{tmp\ 2446}#) + (let ((#{tmp\ 2459}# + ($sc-dispatch + #{tmp\ 2444}# + '((any any) . any)))) + (if (if #{tmp\ 2459}# + (@apply + (lambda (#{a\ 2463}# + #{init\ 2464}# + #{b\ 2465}#) + (#{id?\ 376}# #{a\ 2463}#)) + #{tmp\ 2459}#) + #f) + (@apply + (lambda (#{a\ 2469}# + #{init\ 2470}# + #{b\ 2471}#) + (let ((#{tmp\ 2473}# + (symbol->keyword + (syntax->datum #{a\ 2469}#)))) + (let ((#{k\ 2475}# #{tmp\ 2473}#)) + (#{key\ 2327}# + #{b\ 2471}# + #{req\ 2437}# + #{opt\ 2438}# + (cons (list #{k\ 2475}# + #{a\ 2469}# + #{init\ 2470}#) + #{rkey\ 2439}#))))) + #{tmp\ 2459}#) + (let ((#{tmp\ 2476}# + ($sc-dispatch + #{tmp\ 2444}# + '((any any any) . any)))) + (if (if #{tmp\ 2476}# + (@apply + (lambda (#{a\ 2481}# + #{init\ 2482}# + #{k\ 2483}# + #{b\ 2484}#) + (if (#{id?\ 376}# #{a\ 2481}#) + (keyword? + (syntax->datum #{k\ 2483}#)) + #f)) + #{tmp\ 2476}#) + #f) + (@apply + (lambda (#{a\ 2491}# + #{init\ 2492}# + #{k\ 2493}# + #{b\ 2494}#) + (#{key\ 2327}# + #{b\ 2494}# + #{req\ 2437}# + #{opt\ 2438}# + (cons (list #{k\ 2493}# + #{a\ 2491}# + #{init\ 2492}#) + #{rkey\ 2439}#))) + #{tmp\ 2476}#) + (let ((#{tmp\ 2495}# + ($sc-dispatch + #{tmp\ 2444}# + '(any)))) + (if (if #{tmp\ 2495}# + (@apply + (lambda (#{aok\ 2497}#) + (eq? (syntax->datum + #{aok\ 2497}#) + #:allow-other-keys)) + #{tmp\ 2495}#) + #f) + (@apply + (lambda (#{aok\ 2499}#) + (#{check\ 2331}# + #{req\ 2437}# + #{opt\ 2438}# + #f + (cons #t + (reverse #{rkey\ 2439}#)))) + #{tmp\ 2495}#) + (let ((#{tmp\ 2500}# + ($sc-dispatch + #{tmp\ 2444}# + '(any any any)))) + (if (if #{tmp\ 2500}# + (@apply + (lambda (#{aok\ 2504}# + #{a\ 2505}# + #{b\ 2506}#) + (if (eq? (syntax->datum + #{aok\ 2504}#) + #:allow-other-keys) + (eq? (syntax->datum + #{a\ 2505}#) + #:rest) + #f)) + #{tmp\ 2500}#) + #f) + (@apply + (lambda (#{aok\ 2512}# + #{a\ 2513}# + #{b\ 2514}#) + (#{rest\ 2329}# + #{b\ 2514}# + #{req\ 2437}# + #{opt\ 2438}# + (cons #t + (reverse + #{rkey\ 2439}#)))) + #{tmp\ 2500}#) + (let ((#{tmp\ 2515}# + ($sc-dispatch + #{tmp\ 2444}# + '(any . any)))) + (if (if #{tmp\ 2515}# + (@apply + (lambda (#{aok\ 2518}# + #{r\ 2519}#) + (if (eq? (syntax->datum + #{aok\ 2518}#) + #:allow-other-keys) + (#{id?\ 376}# + #{r\ 2519}#) + #f)) + #{tmp\ 2515}#) + #f) + (@apply + (lambda (#{aok\ 2524}# + #{r\ 2525}#) + (#{rest\ 2329}# + #{r\ 2525}# + #{req\ 2437}# + #{opt\ 2438}# + (cons #t + (reverse + #{rkey\ 2439}#)))) + #{tmp\ 2515}#) + (let ((#{tmp\ 2526}# + ($sc-dispatch + #{tmp\ 2444}# + '(any any)))) + (if (if #{tmp\ 2526}# + (@apply + (lambda (#{a\ 2529}# + #{b\ 2530}#) + (eq? (syntax->datum + #{a\ 2529}#) + #:rest)) + #{tmp\ 2526}#) + #f) + (@apply + (lambda (#{a\ 2533}# + #{b\ 2534}#) + (#{rest\ 2329}# + #{b\ 2534}# + #{req\ 2437}# + #{opt\ 2438}# + (cons #f + (reverse + #{rkey\ 2439}#)))) + #{tmp\ 2526}#) + (let ((#{tmp\ 2535}# + (list #{tmp\ 2444}#))) + (if (if #{tmp\ 2535}# + (@apply + (lambda (#{r\ 2537}#) + (#{id?\ 376}# + #{r\ 2537}#)) + #{tmp\ 2535}#) + #f) + (@apply + (lambda (#{r\ 2539}#) + (#{rest\ 2329}# + #{r\ 2539}# + #{req\ 2437}# + #{opt\ 2438}# + (cons #f + (reverse + #{rkey\ 2439}#)))) + #{tmp\ 2535}#) + (let ((#{else\ 2541}# + #{tmp\ 2444}#)) + (syntax-violation + 'lambda* + "invalid keyword argument list" + #{orig-args\ 2320}# + #{args\ 2436}#))))))))))))))))))))))) + (#{rest\ 2329}# + (lambda (#{args\ 2542}# + #{req\ 2543}# + #{opt\ 2544}# + #{kw\ 2545}#) + (let ((#{tmp\ 2550}# #{args\ 2542}#)) + (let ((#{tmp\ 2551}# (list #{tmp\ 2550}#))) + (if (if #{tmp\ 2551}# + (@apply + (lambda (#{r\ 2553}#) (#{id?\ 376}# #{r\ 2553}#)) + #{tmp\ 2551}#) + #f) + (@apply + (lambda (#{r\ 2555}#) + (#{check\ 2331}# + #{req\ 2543}# + #{opt\ 2544}# + #{r\ 2555}# + #{kw\ 2545}#)) + #{tmp\ 2551}#) + (let ((#{else\ 2557}# #{tmp\ 2550}#)) + (syntax-violation + 'lambda* + "invalid rest argument" + #{orig-args\ 2320}# + #{args\ 2542}#))))))) + (#{check\ 2331}# + (lambda (#{req\ 2558}# + #{opt\ 2559}# + #{rest\ 2560}# + #{kw\ 2561}#) + (if (#{distinct-bound-ids?\ 438}# + (append + #{req\ 2558}# + (map car #{opt\ 2559}#) + (if #{rest\ 2560}# (list #{rest\ 2560}#) '()) + (if (pair? #{kw\ 2561}#) + (map cadr (cdr #{kw\ 2561}#)) + '()))) + (values + #{req\ 2558}# + #{opt\ 2559}# + #{rest\ 2560}# + #{kw\ 2561}#) + (syntax-violation + 'lambda* + "duplicate identifier in argument list" + #{orig-args\ 2320}#))))) + (begin (#{req\ 2323}# #{orig-args\ 2320}# '()))))) + (#{chi-lambda-case\ 480}# + (lambda (#{e\ 2569}# + #{r\ 2570}# + #{w\ 2571}# + #{s\ 2572}# + #{mod\ 2573}# + #{get-formals\ 2574}# + #{clauses\ 2575}#) + (letrec* + ((#{expand-req\ 2584}# + (lambda (#{req\ 2591}# + #{opt\ 2592}# + #{rest\ 2593}# + #{kw\ 2594}# + #{body\ 2595}#) (begin - (let ((#{x\ 3940}# #{ls\ 3936}#)) - (if (not (list? #{x\ 3940}#)) - (syntax-violation - 'generate-temporaries - "invalid argument" - #{x\ 3940}#)))) - (map (lambda (#{x\ 3941}#) - (#{wrap\ 446}# (gensym) '((top)) #f)) - #{ls\ 3936}#)))) - (set! free-identifier=? - (lambda (#{x\ 3945}# #{y\ 3946}#) - (begin - (begin - (let ((#{x\ 3951}# #{x\ 3945}#)) - (if (not (#{nonsymbol-id?\ 378}# #{x\ 3951}#)) - (syntax-violation - 'free-identifier=? - "invalid argument" - #{x\ 3951}#)))) - (begin - (let ((#{x\ 3954}# #{y\ 3946}#)) - (if (not (#{nonsymbol-id?\ 378}# #{x\ 3954}#)) - (syntax-violation - 'free-identifier=? - "invalid argument" - #{x\ 3954}#)))) - (#{free-id=?\ 436}# #{x\ 3945}# #{y\ 3946}#)))) - (set! bound-identifier=? - (lambda (#{x\ 3955}# #{y\ 3956}#) - (begin - (begin - (let ((#{x\ 3961}# #{x\ 3955}#)) - (if (not (#{nonsymbol-id?\ 378}# #{x\ 3961}#)) - (syntax-violation - 'bound-identifier=? - "invalid argument" - #{x\ 3961}#)))) - (begin - (let ((#{x\ 3964}# #{y\ 3956}#)) - (if (not (#{nonsymbol-id?\ 378}# #{x\ 3964}#)) - (syntax-violation - 'bound-identifier=? - "invalid argument" - #{x\ 3964}#)))) - (#{bound-id=?\ 438}# #{x\ 3955}# #{y\ 3956}#)))) - (set! syntax-violation - (lambda* - (#{who\ 3965}# - #{message\ 3966}# - #{form\ 3967}# - #:optional - (#{subform\ 3971}# #f)) - (begin - (begin - (let ((#{x\ 3975}# #{who\ 3965}#)) - (if (not (let ((#{x\ 3976}# #{x\ 3975}#)) - (begin - (let ((#{t\ 3980}# (not #{x\ 3976}#))) - (if #{t\ 3980}# - #{t\ 3980}# - (begin - (let ((#{t\ 3983}# - (string? #{x\ 3976}#))) - (if #{t\ 3983}# - #{t\ 3983}# - (symbol? #{x\ 3976}#))))))))) - (syntax-violation - 'syntax-violation - "invalid argument" - #{x\ 3975}#)))) - (begin - (let ((#{x\ 3987}# #{message\ 3966}#)) - (if (not (string? #{x\ 3987}#)) - (syntax-violation - 'syntax-violation - "invalid argument" - #{x\ 3987}#)))) - (throw 'syntax-error - #{who\ 3965}# - #{message\ 3966}# - (#{source-annotation\ 361}# - (begin - (let ((#{t\ 3990}# #{form\ 3967}#)) - (if #{t\ 3990}# - #{t\ 3990}# - #{subform\ 3971}#)))) - (#{strip\ 486}# #{form\ 3967}# '(())) - (if #{subform\ 3971}# - (#{strip\ 486}# #{subform\ 3971}# '(())) - #f))))) - (letrec* - ((#{match-each\ 3997}# - (lambda (#{e\ 4010}# - #{p\ 4011}# - #{w\ 4012}# - #{mod\ 4013}#) - (if (pair? #{e\ 4010}#) - (begin - (let ((#{first\ 4021}# - (#{match\ 4009}# - (car #{e\ 4010}#) - #{p\ 4011}# - #{w\ 4012}# - '() - #{mod\ 4013}#))) - (if #{first\ 4021}# - (begin - (let ((#{rest\ 4025}# - (#{match-each\ 3997}# - (cdr #{e\ 4010}#) - #{p\ 4011}# - #{w\ 4012}# - #{mod\ 4013}#))) - (if #{rest\ 4025}# - (cons #{first\ 4021}# #{rest\ 4025}#) - #f))) - #f))) - (if (null? #{e\ 4010}#) - '() - (if (#{syntax-object?\ 346}# #{e\ 4010}#) - (#{match-each\ 3997}# - (#{syntax-object-expression\ 348}# #{e\ 4010}#) - #{p\ 4011}# - (#{join-wraps\ 428}# - #{w\ 4012}# - (#{syntax-object-wrap\ 350}# #{e\ 4010}#)) - (#{syntax-object-module\ 352}# #{e\ 4010}#)) - #f))))) - (#{match-each+\ 3999}# - (lambda (#{e\ 4033}# - #{x-pat\ 4034}# - #{y-pat\ 4035}# - #{z-pat\ 4036}# - #{w\ 4037}# - #{r\ 4038}# - #{mod\ 4039}#) - (letrec* - ((#{f\ 4050}# - (lambda (#{e\ 4051}# #{w\ 4052}#) - (if (pair? #{e\ 4051}#) - (call-with-values - (lambda () - (#{f\ 4050}# (cdr #{e\ 4051}#) #{w\ 4052}#)) - (lambda (#{xr*\ 4055}# - #{y-pat\ 4056}# - #{r\ 4057}#) - (if #{r\ 4057}# - (if (null? #{y-pat\ 4056}#) - (begin - (let ((#{xr\ 4062}# - (#{match\ 4009}# - (car #{e\ 4051}#) - #{x-pat\ 4034}# - #{w\ 4052}# - '() - #{mod\ 4039}#))) - (if #{xr\ 4062}# - (values - (cons #{xr\ 4062}# #{xr*\ 4055}#) - #{y-pat\ 4056}# - #{r\ 4057}#) - (values #f #f #f)))) + (let ((#{vars\ 2603}# + (map #{gen-var\ 484}# #{req\ 2591}#)) + (#{labels\ 2604}# + (#{gen-labels\ 391}# #{req\ 2591}#))) + (begin + (let ((#{r*\ 2607}# + (#{extend-var-env\ 366}# + #{labels\ 2604}# + #{vars\ 2603}# + #{r\ 2570}#)) + (#{w*\ 2608}# + (#{make-binding-wrap\ 420}# + #{req\ 2591}# + #{labels\ 2604}# + #{w\ 2571}#))) + (#{expand-opt\ 2586}# + (map syntax->datum #{req\ 2591}#) + #{opt\ 2592}# + #{rest\ 2593}# + #{kw\ 2594}# + #{body\ 2595}# + (reverse #{vars\ 2603}#) + #{r*\ 2607}# + #{w*\ 2608}# + '() + '()))))))) + (#{expand-opt\ 2586}# + (lambda (#{req\ 2609}# + #{opt\ 2610}# + #{rest\ 2611}# + #{kw\ 2612}# + #{body\ 2613}# + #{vars\ 2614}# + #{r*\ 2615}# + #{w*\ 2616}# + #{out\ 2617}# + #{inits\ 2618}#) + (if (pair? #{opt\ 2610}#) + (let ((#{tmp\ 2631}# (car #{opt\ 2610}#))) + (let ((#{tmp\ 2632}# + ($sc-dispatch #{tmp\ 2631}# '(any any)))) + (if #{tmp\ 2632}# + (@apply + (lambda (#{id\ 2635}# #{i\ 2636}#) + (begin + (let ((#{v\ 2639}# + (#{gen-var\ 484}# #{id\ 2635}#))) + (begin + (let ((#{l\ 2641}# + (#{gen-labels\ 391}# + (list #{v\ 2639}#)))) + (begin + (let ((#{r**\ 2643}# + (#{extend-var-env\ 366}# + #{l\ 2641}# + (list #{v\ 2639}#) + #{r*\ 2615}#))) + (begin + (let ((#{w**\ 2645}# + (#{make-binding-wrap\ 420}# + (list #{id\ 2635}#) + #{l\ 2641}# + #{w*\ 2616}#))) + (#{expand-opt\ 2586}# + #{req\ 2609}# + (cdr #{opt\ 2610}#) + #{rest\ 2611}# + #{kw\ 2612}# + #{body\ 2613}# + (cons #{v\ 2639}# + #{vars\ 2614}#) + #{r**\ 2643}# + #{w**\ 2645}# + (cons (syntax->datum + #{id\ 2635}#) + #{out\ 2617}#) + (cons (#{chi\ 456}# + #{i\ 2636}# + #{r*\ 2615}# + #{w*\ 2616}# + #{mod\ 2573}#) + #{inits\ 2618}#))))))))))) + #{tmp\ 2632}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 2631}#)))) + (if #{rest\ 2611}# + (begin + (let ((#{v\ 2650}# (#{gen-var\ 484}# #{rest\ 2611}#))) + (begin + (let ((#{l\ 2652}# + (#{gen-labels\ 391}# (list #{v\ 2650}#)))) + (begin + (let ((#{r*\ 2654}# + (#{extend-var-env\ 366}# + #{l\ 2652}# + (list #{v\ 2650}#) + #{r*\ 2615}#))) + (begin + (let ((#{w*\ 2656}# + (#{make-binding-wrap\ 420}# + (list #{rest\ 2611}#) + #{l\ 2652}# + #{w*\ 2616}#))) + (#{expand-kw\ 2588}# + #{req\ 2609}# + (if (pair? #{out\ 2617}#) + (reverse #{out\ 2617}#) + #f) + (syntax->datum #{rest\ 2611}#) + (if (pair? #{kw\ 2612}#) + (cdr #{kw\ 2612}#) + #{kw\ 2612}#) + #{body\ 2613}# + (cons #{v\ 2650}# #{vars\ 2614}#) + #{r*\ 2654}# + #{w*\ 2656}# + (if (pair? #{kw\ 2612}#) + (car #{kw\ 2612}#) + #f) + '() + #{inits\ 2618}#))))))))) + (#{expand-kw\ 2588}# + #{req\ 2609}# + (if (pair? #{out\ 2617}#) + (reverse #{out\ 2617}#) + #f) + #f + (if (pair? #{kw\ 2612}#) + (cdr #{kw\ 2612}#) + #{kw\ 2612}#) + #{body\ 2613}# + #{vars\ 2614}# + #{r*\ 2615}# + #{w*\ 2616}# + (if (pair? #{kw\ 2612}#) (car #{kw\ 2612}#) #f) + '() + #{inits\ 2618}#))))) + (#{expand-kw\ 2588}# + (lambda (#{req\ 2658}# + #{opt\ 2659}# + #{rest\ 2660}# + #{kw\ 2661}# + #{body\ 2662}# + #{vars\ 2663}# + #{r*\ 2664}# + #{w*\ 2665}# + #{aok\ 2666}# + #{out\ 2667}# + #{inits\ 2668}#) + (if (pair? #{kw\ 2661}#) + (let ((#{tmp\ 2682}# (car #{kw\ 2661}#))) + (let ((#{tmp\ 2683}# + ($sc-dispatch #{tmp\ 2682}# '(any any any)))) + (if #{tmp\ 2683}# + (@apply + (lambda (#{k\ 2687}# #{id\ 2688}# #{i\ 2689}#) + (begin + (let ((#{v\ 2692}# + (#{gen-var\ 484}# #{id\ 2688}#))) + (begin + (let ((#{l\ 2694}# + (#{gen-labels\ 391}# + (list #{v\ 2692}#)))) + (begin + (let ((#{r**\ 2696}# + (#{extend-var-env\ 366}# + #{l\ 2694}# + (list #{v\ 2692}#) + #{r*\ 2664}#))) + (begin + (let ((#{w**\ 2698}# + (#{make-binding-wrap\ 420}# + (list #{id\ 2688}#) + #{l\ 2694}# + #{w*\ 2665}#))) + (#{expand-kw\ 2588}# + #{req\ 2658}# + #{opt\ 2659}# + #{rest\ 2660}# + (cdr #{kw\ 2661}#) + #{body\ 2662}# + (cons #{v\ 2692}# + #{vars\ 2663}#) + #{r**\ 2696}# + #{w**\ 2698}# + #{aok\ 2666}# + (cons (list (syntax->datum + #{k\ 2687}#) + (syntax->datum + #{id\ 2688}#) + #{v\ 2692}#) + #{out\ 2667}#) + (cons (#{chi\ 456}# + #{i\ 2689}# + #{r*\ 2664}# + #{w*\ 2665}# + #{mod\ 2573}#) + #{inits\ 2668}#))))))))))) + #{tmp\ 2683}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 2682}#)))) + (#{expand-body\ 2590}# + #{req\ 2658}# + #{opt\ 2659}# + #{rest\ 2660}# + (if (begin + (let ((#{t\ 2702}# #{aok\ 2666}#)) + (if #{t\ 2702}# + #{t\ 2702}# + (pair? #{out\ 2667}#)))) + (cons #{aok\ 2666}# (reverse #{out\ 2667}#)) + #f) + #{body\ 2662}# + (reverse #{vars\ 2663}#) + #{r*\ 2664}# + #{w*\ 2665}# + (reverse #{inits\ 2668}#) + '())))) + (#{expand-body\ 2590}# + (lambda (#{req\ 2704}# + #{opt\ 2705}# + #{rest\ 2706}# + #{kw\ 2707}# + #{body\ 2708}# + #{vars\ 2709}# + #{r*\ 2710}# + #{w*\ 2711}# + #{inits\ 2712}# + #{meta\ 2713}#) + (let ((#{tmp\ 2724}# #{body\ 2708}#)) + (let ((#{tmp\ 2725}# + ($sc-dispatch + #{tmp\ 2724}# + '(any any . each-any)))) + (if (if #{tmp\ 2725}# + (@apply + (lambda (#{docstring\ 2729}# + #{e1\ 2730}# + #{e2\ 2731}#) + (string? (syntax->datum #{docstring\ 2729}#))) + #{tmp\ 2725}#) + #f) + (@apply + (lambda (#{docstring\ 2735}# + #{e1\ 2736}# + #{e2\ 2737}#) + (#{expand-body\ 2590}# + #{req\ 2704}# + #{opt\ 2705}# + #{rest\ 2706}# + #{kw\ 2707}# + (cons #{e1\ 2736}# #{e2\ 2737}#) + #{vars\ 2709}# + #{r*\ 2710}# + #{w*\ 2711}# + #{inits\ 2712}# + (append + #{meta\ 2713}# + (list (cons 'documentation + (syntax->datum + #{docstring\ 2735}#)))))) + #{tmp\ 2725}#) + (let ((#{tmp\ 2740}# + ($sc-dispatch + #{tmp\ 2724}# + '(#(vector #(each (any . any))) + any + . + each-any)))) + (if #{tmp\ 2740}# + (@apply + (lambda (#{k\ 2745}# + #{v\ 2746}# + #{e1\ 2747}# + #{e2\ 2748}#) + (#{expand-body\ 2590}# + #{req\ 2704}# + #{opt\ 2705}# + #{rest\ 2706}# + #{kw\ 2707}# + (cons #{e1\ 2747}# #{e2\ 2748}#) + #{vars\ 2709}# + #{r*\ 2710}# + #{w*\ 2711}# + #{inits\ 2712}# + (append + #{meta\ 2713}# + (syntax->datum + (map cons #{k\ 2745}# #{v\ 2746}#))))) + #{tmp\ 2740}#) + (let ((#{tmp\ 2752}# + ($sc-dispatch + #{tmp\ 2724}# + '(any . each-any)))) + (if #{tmp\ 2752}# + (@apply + (lambda (#{e1\ 2755}# #{e2\ 2756}#) (values - '() - (cdr #{y-pat\ 4056}#) - (#{match\ 4009}# - (car #{e\ 4051}#) - (car #{y-pat\ 4056}#) - #{w\ 4052}# - #{r\ 4057}# - #{mod\ 4039}#))) - (values #f #f #f)))) - (if (#{syntax-object?\ 346}# #{e\ 4051}#) - (#{f\ 4050}# - (#{syntax-object-expression\ 348}# #{e\ 4051}#) - (#{join-wraps\ 428}# #{w\ 4052}# #{e\ 4051}#)) - (values - '() - #{y-pat\ 4035}# - (#{match\ 4009}# - #{e\ 4051}# - #{z-pat\ 4036}# - #{w\ 4052}# - #{r\ 4038}# - #{mod\ 4039}#))))))) - (begin (#{f\ 4050}# #{e\ 4033}# #{w\ 4037}#))))) - (#{match-each-any\ 4001}# - (lambda (#{e\ 4066}# #{w\ 4067}# #{mod\ 4068}#) - (if (pair? #{e\ 4066}#) - (begin - (let ((#{l\ 4075}# - (#{match-each-any\ 4001}# - (cdr #{e\ 4066}#) - #{w\ 4067}# - #{mod\ 4068}#))) - (if #{l\ 4075}# - (cons (#{wrap\ 446}# - (car #{e\ 4066}#) - #{w\ 4067}# - #{mod\ 4068}#) - #{l\ 4075}#) - #f))) - (if (null? #{e\ 4066}#) - '() - (if (#{syntax-object?\ 346}# #{e\ 4066}#) - (#{match-each-any\ 4001}# - (#{syntax-object-expression\ 348}# #{e\ 4066}#) - (#{join-wraps\ 428}# - #{w\ 4067}# - (#{syntax-object-wrap\ 350}# #{e\ 4066}#)) - #{mod\ 4068}#) - #f))))) - (#{match-empty\ 4003}# - (lambda (#{p\ 4083}# #{r\ 4084}#) - (if (null? #{p\ 4083}#) - #{r\ 4084}# - (if (eq? #{p\ 4083}# '_) - #{r\ 4084}# - (if (eq? #{p\ 4083}# 'any) - (cons '() #{r\ 4084}#) - (if (pair? #{p\ 4083}#) - (#{match-empty\ 4003}# - (car #{p\ 4083}#) - (#{match-empty\ 4003}# - (cdr #{p\ 4083}#) - #{r\ 4084}#)) - (if (eq? #{p\ 4083}# 'each-any) - (cons '() #{r\ 4084}#) - (begin - (let ((#{atom-key\ 4100}# - (vector-ref #{p\ 4083}# 0))) - (if (eqv? #{atom-key\ 4100}# 'each) - (#{match-empty\ 4003}# - (vector-ref #{p\ 4083}# 1) - #{r\ 4084}#) - (if (eqv? #{atom-key\ 4100}# 'each+) - (#{match-empty\ 4003}# - (vector-ref #{p\ 4083}# 1) - (#{match-empty\ 4003}# - (reverse (vector-ref #{p\ 4083}# 2)) - (#{match-empty\ 4003}# - (vector-ref #{p\ 4083}# 3) - #{r\ 4084}#))) - (if (if (eqv? #{atom-key\ 4100}# 'free-id) - #t - (eqv? #{atom-key\ 4100}# 'atom)) - #{r\ 4084}# - (if (eqv? #{atom-key\ 4100}# 'vector) - (#{match-empty\ 4003}# - (vector-ref #{p\ 4083}# 1) - #{r\ 4084}#)))))))))))))) - (#{combine\ 4005}# - (lambda (#{r*\ 4105}# #{r\ 4106}#) - (if (null? (car #{r*\ 4105}#)) - #{r\ 4106}# - (cons (map car #{r*\ 4105}#) - (#{combine\ 4005}# - (map cdr #{r*\ 4105}#) - #{r\ 4106}#))))) - (#{match*\ 4007}# - (lambda (#{e\ 4109}# - #{p\ 4110}# - #{w\ 4111}# - #{r\ 4112}# - #{mod\ 4113}#) - (if (null? #{p\ 4110}#) - (if (null? #{e\ 4109}#) #{r\ 4112}# #f) - (if (pair? #{p\ 4110}#) - (if (pair? #{e\ 4109}#) - (#{match\ 4009}# - (car #{e\ 4109}#) - (car #{p\ 4110}#) - #{w\ 4111}# - (#{match\ 4009}# - (cdr #{e\ 4109}#) - (cdr #{p\ 4110}#) - #{w\ 4111}# - #{r\ 4112}# - #{mod\ 4113}#) - #{mod\ 4113}#) - #f) - (if (eq? #{p\ 4110}# 'each-any) - (begin - (let ((#{l\ 4130}# - (#{match-each-any\ 4001}# - #{e\ 4109}# - #{w\ 4111}# - #{mod\ 4113}#))) - (if #{l\ 4130}# - (cons #{l\ 4130}# #{r\ 4112}#) - #f))) - (begin - (let ((#{atom-key\ 4136}# - (vector-ref #{p\ 4110}# 0))) - (if (eqv? #{atom-key\ 4136}# 'each) - (if (null? #{e\ 4109}#) - (#{match-empty\ 4003}# - (vector-ref #{p\ 4110}# 1) - #{r\ 4112}#) - (begin - (let ((#{l\ 4139}# - (#{match-each\ 3997}# - #{e\ 4109}# - (vector-ref #{p\ 4110}# 1) - #{w\ 4111}# - #{mod\ 4113}#))) - (if #{l\ 4139}# - (letrec* - ((#{collect\ 4144}# - (lambda (#{l\ 4145}#) - (if (null? (car #{l\ 4145}#)) - #{r\ 4112}# - (cons (map car #{l\ 4145}#) - (#{collect\ 4144}# - (map cdr - #{l\ 4145}#))))))) - (begin - (#{collect\ 4144}# #{l\ 4139}#))) - #f)))) - (if (eqv? #{atom-key\ 4136}# 'each+) + #{meta\ 2713}# + #{req\ 2704}# + #{opt\ 2705}# + #{rest\ 2706}# + #{kw\ 2707}# + #{inits\ 2712}# + #{vars\ 2709}# + (#{chi-body\ 464}# + (cons #{e1\ 2755}# #{e2\ 2756}#) + (#{source-wrap\ 444}# + #{e\ 2569}# + #{w\ 2571}# + #{s\ 2572}# + #{mod\ 2573}#) + #{r*\ 2710}# + #{w*\ 2711}# + #{mod\ 2573}#))) + #{tmp\ 2752}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 2724}#))))))))))) + (begin + (let ((#{tmp\ 2758}# #{clauses\ 2575}#)) + (let ((#{tmp\ 2759}# ($sc-dispatch #{tmp\ 2758}# '()))) + (if #{tmp\ 2759}# + (@apply + (lambda () (values '() #f)) + #{tmp\ 2759}#) + (let ((#{tmp\ 2760}# + ($sc-dispatch + #{tmp\ 2758}# + '((any any . each-any) + . + #(each (any any . each-any)))))) + (if #{tmp\ 2760}# + (@apply + (lambda (#{args\ 2767}# + #{e1\ 2768}# + #{e2\ 2769}# + #{args*\ 2770}# + #{e1*\ 2771}# + #{e2*\ 2772}#) + (call-with-values + (lambda () + (#{get-formals\ 2574}# #{args\ 2767}#)) + (lambda (#{req\ 2773}# + #{opt\ 2774}# + #{rest\ 2775}# + #{kw\ 2776}#) (call-with-values (lambda () - (#{match-each+\ 3999}# - #{e\ 4109}# - (vector-ref #{p\ 4110}# 1) - (vector-ref #{p\ 4110}# 2) - (vector-ref #{p\ 4110}# 3) - #{w\ 4111}# - #{r\ 4112}# - #{mod\ 4113}#)) - (lambda (#{xr*\ 4147}# - #{y-pat\ 4148}# - #{r\ 4149}#) - (if #{r\ 4149}# - (if (null? #{y-pat\ 4148}#) - (if (null? #{xr*\ 4147}#) - (#{match-empty\ 4003}# - (vector-ref #{p\ 4110}# 1) - #{r\ 4149}#) - (#{combine\ 4005}# - #{xr*\ 4147}# - #{r\ 4149}#)) - #f) - #f))) - (if (eqv? #{atom-key\ 4136}# 'free-id) - (if (#{id?\ 380}# #{e\ 4109}#) - (if (#{free-id=?\ 436}# - (#{wrap\ 446}# - #{e\ 4109}# - #{w\ 4111}# - #{mod\ 4113}#) - (vector-ref #{p\ 4110}# 1)) - #{r\ 4112}# - #f) - #f) - (if (eqv? #{atom-key\ 4136}# 'atom) - (if (equal? - (vector-ref #{p\ 4110}# 1) - (#{strip\ 486}# - #{e\ 4109}# - #{w\ 4111}#)) - #{r\ 4112}# - #f) - (if (eqv? #{atom-key\ 4136}# 'vector) - (if (vector? #{e\ 4109}#) - (#{match\ 4009}# - (vector->list #{e\ 4109}#) - (vector-ref #{p\ 4110}# 1) - #{w\ 4111}# - #{r\ 4112}# - #{mod\ 4113}#) - #f))))))))))))) - (#{match\ 4009}# - (lambda (#{e\ 4166}# - #{p\ 4167}# - #{w\ 4168}# - #{r\ 4169}# - #{mod\ 4170}#) - (if (not #{r\ 4169}#) - #f - (if (eq? #{p\ 4167}# '_) - #{r\ 4169}# - (if (eq? #{p\ 4167}# 'any) - (cons (#{wrap\ 446}# - #{e\ 4166}# - #{w\ 4168}# - #{mod\ 4170}#) - #{r\ 4169}#) - (if (#{syntax-object?\ 346}# #{e\ 4166}#) - (#{match*\ 4007}# - (#{syntax-object-expression\ 348}# #{e\ 4166}#) - #{p\ 4167}# - (#{join-wraps\ 428}# - #{w\ 4168}# - (#{syntax-object-wrap\ 350}# #{e\ 4166}#)) - #{r\ 4169}# - (#{syntax-object-module\ 352}# #{e\ 4166}#)) - (#{match*\ 4007}# - #{e\ 4166}# - #{p\ 4167}# - #{w\ 4168}# - #{r\ 4169}# - #{mod\ 4170}#)))))))) + (#{expand-req\ 2584}# + #{req\ 2773}# + #{opt\ 2774}# + #{rest\ 2775}# + #{kw\ 2776}# + (cons #{e1\ 2768}# #{e2\ 2769}#))) + (lambda (#{meta\ 2782}# + #{req\ 2783}# + #{opt\ 2784}# + #{rest\ 2785}# + #{kw\ 2786}# + #{inits\ 2787}# + #{vars\ 2788}# + #{body\ 2789}#) + (call-with-values + (lambda () + (#{chi-lambda-case\ 480}# + #{e\ 2569}# + #{r\ 2570}# + #{w\ 2571}# + #{s\ 2572}# + #{mod\ 2573}# + #{get-formals\ 2574}# + (map (lambda (#{tmp\ 2800}# + #{tmp\ 2799}# + #{tmp\ 2798}#) + (cons #{tmp\ 2798}# + (cons #{tmp\ 2799}# + #{tmp\ 2800}#))) + #{e2*\ 2772}# + #{e1*\ 2771}# + #{args*\ 2770}#))) + (lambda (#{meta*\ 2802}# + #{else*\ 2803}#) + (values + (append + #{meta\ 2782}# + #{meta*\ 2802}#) + (#{build-lambda-case\ 324}# + #{s\ 2572}# + #{req\ 2783}# + #{opt\ 2784}# + #{rest\ 2785}# + #{kw\ 2786}# + #{inits\ 2787}# + #{vars\ 2788}# + #{body\ 2789}# + #{else*\ 2803}#))))))))) + #{tmp\ 2760}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 2758}#)))))))))) + (#{strip\ 482}# + (lambda (#{x\ 2806}# #{w\ 2807}#) + (if (memq 'top (car #{w\ 2807}#)) + #{x\ 2806}# + (letrec* + ((#{f\ 2814}# + (lambda (#{x\ 2815}#) + (if (#{syntax-object?\ 342}# #{x\ 2815}#) + (#{strip\ 482}# + (#{syntax-object-expression\ 344}# #{x\ 2815}#) + (#{syntax-object-wrap\ 346}# #{x\ 2815}#)) + (if (pair? #{x\ 2815}#) + (begin + (let ((#{a\ 2822}# (#{f\ 2814}# (car #{x\ 2815}#))) + (#{d\ 2823}# (#{f\ 2814}# (cdr #{x\ 2815}#)))) + (if (if (eq? #{a\ 2822}# (car #{x\ 2815}#)) + (eq? #{d\ 2823}# (cdr #{x\ 2815}#)) + #f) + #{x\ 2815}# + (cons #{a\ 2822}# #{d\ 2823}#)))) + (if (vector? #{x\ 2815}#) + (begin + (let ((#{old\ 2829}# (vector->list #{x\ 2815}#))) + (begin + (let ((#{new\ 2831}# + (map #{f\ 2814}# #{old\ 2829}#))) + (if (#{and-map*\ 38}# + eq? + #{old\ 2829}# + #{new\ 2831}#) + #{x\ 2815}# + (list->vector #{new\ 2831}#)))))) + #{x\ 2815}#)))))) + (begin (#{f\ 2814}# #{x\ 2806}#)))))) + (#{gen-var\ 484}# + (lambda (#{id\ 2833}#) + (begin + (let ((#{id\ 2836}# + (if (#{syntax-object?\ 342}# #{id\ 2833}#) + (#{syntax-object-expression\ 344}# #{id\ 2833}#) + #{id\ 2833}#))) + (gensym + (string-append (symbol->string #{id\ 2836}#) " ")))))) + (#{lambda-var-list\ 486}# + (lambda (#{vars\ 2838}#) + (letrec* + ((#{lvl\ 2844}# + (lambda (#{vars\ 2845}# #{ls\ 2846}# #{w\ 2847}#) + (if (pair? #{vars\ 2845}#) + (#{lvl\ 2844}# + (cdr #{vars\ 2845}#) + (cons (#{wrap\ 442}# + (car #{vars\ 2845}#) + #{w\ 2847}# + #f) + #{ls\ 2846}#) + #{w\ 2847}#) + (if (#{id?\ 376}# #{vars\ 2845}#) + (cons (#{wrap\ 442}# #{vars\ 2845}# #{w\ 2847}# #f) + #{ls\ 2846}#) + (if (null? #{vars\ 2845}#) + #{ls\ 2846}# + (if (#{syntax-object?\ 342}# #{vars\ 2845}#) + (#{lvl\ 2844}# + (#{syntax-object-expression\ 344}# + #{vars\ 2845}#) + #{ls\ 2846}# + (#{join-wraps\ 424}# + #{w\ 2847}# + (#{syntax-object-wrap\ 346}# #{vars\ 2845}#))) + (cons #{vars\ 2845}# #{ls\ 2846}#)))))))) + (begin (#{lvl\ 2844}# #{vars\ 2838}# '() '(()))))))) + (begin + (lambda (#{src\ 804}# #{name\ 805}#) + (make-struct/no-tail + (vector-ref %expanded-vtables 2) + #{src\ 804}# + #{name\ 805}#)) + (lambda (#{x\ 1182}# #{update\ 1183}#) + (vector-set! #{x\ 1182}# 1 #{update\ 1183}#)) + (lambda (#{x\ 1186}# #{update\ 1187}#) + (vector-set! #{x\ 1186}# 2 #{update\ 1187}#)) + (lambda (#{x\ 1190}# #{update\ 1191}#) + (vector-set! #{x\ 1190}# 3 #{update\ 1191}#)) + (lambda (#{x\ 1271}#) + (if (vector? #{x\ 1271}#) + (if (= (vector-length #{x\ 1271}#) 4) + (eq? (vector-ref #{x\ 1271}# 0) 'ribcage) + #f) + #f)) + (begin + (#{global-extend\ 372}# + 'local-syntax + 'letrec-syntax + #t) + (#{global-extend\ 372}# + 'local-syntax + 'let-syntax + #f) + (#{global-extend\ 372}# + 'core + 'fluid-let-syntax + (lambda (#{e\ 2858}# + #{r\ 2859}# + #{w\ 2860}# + #{s\ 2861}# + #{mod\ 2862}#) + (let ((#{tmp\ 2868}# #{e\ 2858}#)) + (let ((#{tmp\ 2869}# + ($sc-dispatch + #{tmp\ 2868}# + '(_ #(each (any any)) any . each-any)))) + (if (if #{tmp\ 2869}# + (@apply + (lambda (#{var\ 2874}# + #{val\ 2875}# + #{e1\ 2876}# + #{e2\ 2877}#) + (#{valid-bound-ids?\ 436}# #{var\ 2874}#)) + #{tmp\ 2869}#) + #f) + (@apply + (lambda (#{var\ 2883}# + #{val\ 2884}# + #{e1\ 2885}# + #{e2\ 2886}#) + (begin + (let ((#{names\ 2888}# + (map (lambda (#{x\ 2889}#) + (#{id-var-name\ 430}# + #{x\ 2889}# + #{w\ 2860}#)) + #{var\ 2883}#))) + (begin + (for-each + (lambda (#{id\ 2892}# #{n\ 2893}#) + (begin + (let ((#{atom-key\ 2898}# + (car (#{lookup\ 370}# + #{n\ 2893}# + #{r\ 2859}# + #{mod\ 2862}#)))) + (if (eqv? #{atom-key\ 2898}# + 'displaced-lexical) + (syntax-violation + 'fluid-let-syntax + "identifier out of context" + #{e\ 2858}# + (#{source-wrap\ 444}# + #{id\ 2892}# + #{w\ 2860}# + #{s\ 2861}# + #{mod\ 2862}#)))))) + #{var\ 2883}# + #{names\ 2888}#) + (#{chi-body\ 464}# + (cons #{e1\ 2885}# #{e2\ 2886}#) + (#{source-wrap\ 444}# + #{e\ 2858}# + #{w\ 2860}# + #{s\ 2861}# + #{mod\ 2862}#) + (#{extend-env\ 364}# + #{names\ 2888}# + (begin + (let ((#{trans-r\ 2904}# + (#{macros-only-env\ 368}# + #{r\ 2859}#))) + (map (lambda (#{x\ 2905}#) + (cons 'macro + (#{eval-local-transformer\ 468}# + (#{chi\ 456}# + #{x\ 2905}# + #{trans-r\ 2904}# + #{w\ 2860}# + #{mod\ 2862}#) + #{mod\ 2862}#))) + #{val\ 2884}#))) + #{r\ 2859}#) + #{w\ 2860}# + #{mod\ 2862}#))))) + #{tmp\ 2869}#) + (let ((#{_\ 2910}# #{tmp\ 2868}#)) + (syntax-violation + 'fluid-let-syntax + "bad syntax" + (#{source-wrap\ 444}# + #{e\ 2858}# + #{w\ 2860}# + #{s\ 2861}# + #{mod\ 2862}#)))))))) + (#{global-extend\ 372}# + 'core + 'quote + (lambda (#{e\ 2911}# + #{r\ 2912}# + #{w\ 2913}# + #{s\ 2914}# + #{mod\ 2915}#) + (let ((#{tmp\ 2921}# #{e\ 2911}#)) + (let ((#{tmp\ 2922}# + ($sc-dispatch #{tmp\ 2921}# '(_ any)))) + (if #{tmp\ 2922}# + (@apply + (lambda (#{e\ 2924}#) + (#{build-data\ 328}# + #{s\ 2914}# + (#{strip\ 482}# #{e\ 2924}# #{w\ 2913}#))) + #{tmp\ 2922}#) + (let ((#{_\ 2926}# #{tmp\ 2921}#)) + (syntax-violation + 'quote + "bad syntax" + (#{source-wrap\ 444}# + #{e\ 2911}# + #{w\ 2913}# + #{s\ 2914}# + #{mod\ 2915}#)))))))) + (#{global-extend\ 372}# + 'core + 'syntax + (letrec* + ((#{gen-syntax\ 2928}# + (lambda (#{src\ 2943}# + #{e\ 2944}# + #{r\ 2945}# + #{maps\ 2946}# + #{ellipsis?\ 2947}# + #{mod\ 2948}#) + (if (#{id?\ 376}# #{e\ 2944}#) + (begin + (let ((#{label\ 2956}# + (#{id-var-name\ 430}# #{e\ 2944}# '(())))) + (begin + (let ((#{b\ 2959}# + (#{lookup\ 370}# + #{label\ 2956}# + #{r\ 2945}# + #{mod\ 2948}#))) + (if (eq? (car #{b\ 2959}#) 'syntax) + (call-with-values + (lambda () + (begin + (let ((#{var.lev\ 2962}# + (cdr #{b\ 2959}#))) + (#{gen-ref\ 2930}# + #{src\ 2943}# + (car #{var.lev\ 2962}#) + (cdr #{var.lev\ 2962}#) + #{maps\ 2946}#)))) + (lambda (#{var\ 2964}# #{maps\ 2965}#) + (values + (list 'ref #{var\ 2964}#) + #{maps\ 2965}#))) + (if (#{ellipsis?\ 2947}# #{e\ 2944}#) + (syntax-violation + 'syntax + "misplaced ellipsis" + #{src\ 2943}#) + (values + (list 'quote #{e\ 2944}#) + #{maps\ 2946}#))))))) + (let ((#{tmp\ 2970}# #{e\ 2944}#)) + (let ((#{tmp\ 2971}# + ($sc-dispatch #{tmp\ 2970}# '(any any)))) + (if (if #{tmp\ 2971}# + (@apply + (lambda (#{dots\ 2974}# #{e\ 2975}#) + (#{ellipsis?\ 2947}# #{dots\ 2974}#)) + #{tmp\ 2971}#) + #f) + (@apply + (lambda (#{dots\ 2978}# #{e\ 2979}#) + (#{gen-syntax\ 2928}# + #{src\ 2943}# + #{e\ 2979}# + #{r\ 2945}# + #{maps\ 2946}# + (lambda (#{x\ 2980}#) #f) + #{mod\ 2948}#)) + #{tmp\ 2971}#) + (let ((#{tmp\ 2982}# + ($sc-dispatch + #{tmp\ 2970}# + '(any any . any)))) + (if (if #{tmp\ 2982}# + (@apply + (lambda (#{x\ 2986}# + #{dots\ 2987}# + #{y\ 2988}#) + (#{ellipsis?\ 2947}# #{dots\ 2987}#)) + #{tmp\ 2982}#) + #f) + (@apply + (lambda (#{x\ 2992}# + #{dots\ 2993}# + #{y\ 2994}#) + (letrec* + ((#{f\ 2998}# + (lambda (#{y\ 2999}# #{k\ 3000}#) + (let ((#{tmp\ 3007}# #{y\ 2999}#)) + (let ((#{tmp\ 3008}# + ($sc-dispatch + #{tmp\ 3007}# + '(any . any)))) + (if (if #{tmp\ 3008}# + (@apply + (lambda (#{dots\ 3011}# + #{y\ 3012}#) + (#{ellipsis?\ 2947}# + #{dots\ 3011}#)) + #{tmp\ 3008}#) + #f) + (@apply + (lambda (#{dots\ 3015}# + #{y\ 3016}#) + (#{f\ 2998}# + #{y\ 3016}# + (lambda (#{maps\ 3017}#) + (call-with-values + (lambda () + (#{k\ 3000}# + (cons '() + #{maps\ 3017}#))) + (lambda (#{x\ 3019}# + #{maps\ 3020}#) + (if (null? (car #{maps\ 3020}#)) + (syntax-violation + 'syntax + "extra ellipsis" + #{src\ 2943}#) + (values + (#{gen-mappend\ 2932}# + #{x\ 3019}# + (car #{maps\ 3020}#)) + (cdr #{maps\ 3020}#)))))))) + #{tmp\ 3008}#) + (let ((#{_\ 3024}# + #{tmp\ 3007}#)) + (call-with-values + (lambda () + (#{gen-syntax\ 2928}# + #{src\ 2943}# + #{y\ 2999}# + #{r\ 2945}# + #{maps\ 2946}# + #{ellipsis?\ 2947}# + #{mod\ 2948}#)) + (lambda (#{y\ 3025}# + #{maps\ 3026}#) + (call-with-values + (lambda () + (#{k\ 3000}# + #{maps\ 3026}#)) + (lambda (#{x\ 3029}# + #{maps\ 3030}#) + (values + (#{gen-append\ 2938}# + #{x\ 3029}# + #{y\ 3025}#) + #{maps\ 3030}#)))))))))))) + (begin + (#{f\ 2998}# + #{y\ 2994}# + (lambda (#{maps\ 3001}#) + (call-with-values + (lambda () + (#{gen-syntax\ 2928}# + #{src\ 2943}# + #{x\ 2992}# + #{r\ 2945}# + (cons '() #{maps\ 3001}#) + #{ellipsis?\ 2947}# + #{mod\ 2948}#)) + (lambda (#{x\ 3003}# + #{maps\ 3004}#) + (if (null? (car #{maps\ 3004}#)) + (syntax-violation + 'syntax + "extra ellipsis" + #{src\ 2943}#) + (values + (#{gen-map\ 2934}# + #{x\ 3003}# + (car #{maps\ 3004}#)) + (cdr #{maps\ 3004}#)))))))))) + #{tmp\ 2982}#) + (let ((#{tmp\ 3033}# + ($sc-dispatch + #{tmp\ 2970}# + '(any . any)))) + (if #{tmp\ 3033}# + (@apply + (lambda (#{x\ 3036}# #{y\ 3037}#) + (call-with-values + (lambda () + (#{gen-syntax\ 2928}# + #{src\ 2943}# + #{x\ 3036}# + #{r\ 2945}# + #{maps\ 2946}# + #{ellipsis?\ 2947}# + #{mod\ 2948}#)) + (lambda (#{x\ 3038}# #{maps\ 3039}#) + (call-with-values + (lambda () + (#{gen-syntax\ 2928}# + #{src\ 2943}# + #{y\ 3037}# + #{r\ 2945}# + #{maps\ 3039}# + #{ellipsis?\ 2947}# + #{mod\ 2948}#)) + (lambda (#{y\ 3042}# + #{maps\ 3043}#) + (values + (#{gen-cons\ 2936}# + #{x\ 3038}# + #{y\ 3042}#) + #{maps\ 3043}#)))))) + #{tmp\ 3033}#) + (let ((#{tmp\ 3046}# + ($sc-dispatch + #{tmp\ 2970}# + '#(vector (any . each-any))))) + (if #{tmp\ 3046}# + (@apply + (lambda (#{e1\ 3049}# #{e2\ 3050}#) + (call-with-values + (lambda () + (#{gen-syntax\ 2928}# + #{src\ 2943}# + (cons #{e1\ 3049}# + #{e2\ 3050}#) + #{r\ 2945}# + #{maps\ 2946}# + #{ellipsis?\ 2947}# + #{mod\ 2948}#)) + (lambda (#{e\ 3052}# + #{maps\ 3053}#) + (values + (#{gen-vector\ 2940}# + #{e\ 3052}#) + #{maps\ 3053}#)))) + #{tmp\ 3046}#) + (let ((#{_\ 3057}# #{tmp\ 2970}#)) + (values + (list 'quote #{e\ 2944}#) + #{maps\ 2946}#)))))))))))))) + (#{gen-ref\ 2930}# + (lambda (#{src\ 3059}# + #{var\ 3060}# + #{level\ 3061}# + #{maps\ 3062}#) + (if (= #{level\ 3061}# 0) + (values #{var\ 3060}# #{maps\ 3062}#) + (if (null? #{maps\ 3062}#) + (syntax-violation + 'syntax + "missing ellipsis" + #{src\ 3059}#) + (call-with-values + (lambda () + (#{gen-ref\ 2930}# + #{src\ 3059}# + #{var\ 3060}# + (1- #{level\ 3061}#) + (cdr #{maps\ 3062}#))) + (lambda (#{outer-var\ 3069}# #{outer-maps\ 3070}#) + (begin + (let ((#{b\ 3074}# + (assq #{outer-var\ 3069}# + (car #{maps\ 3062}#)))) + (if #{b\ 3074}# + (values (cdr #{b\ 3074}#) #{maps\ 3062}#) + (begin + (let ((#{inner-var\ 3076}# + (#{gen-var\ 484}# 'tmp))) + (values + #{inner-var\ 3076}# + (cons (cons (cons #{outer-var\ 3069}# + #{inner-var\ 3076}#) + (car #{maps\ 3062}#)) + #{outer-maps\ 3070}#))))))))))))) + (#{gen-mappend\ 2932}# + (lambda (#{e\ 3077}# #{map-env\ 3078}#) + (list 'apply + '(primitive append) + (#{gen-map\ 2934}# #{e\ 3077}# #{map-env\ 3078}#)))) + (#{gen-map\ 2934}# + (lambda (#{e\ 3082}# #{map-env\ 3083}#) + (begin + (let ((#{formals\ 3088}# (map cdr #{map-env\ 3083}#)) + (#{actuals\ 3089}# + (map (lambda (#{x\ 3090}#) + (list 'ref (car #{x\ 3090}#))) + #{map-env\ 3083}#))) + (if (eq? (car #{e\ 3082}#) 'ref) + (car #{actuals\ 3089}#) + (if (and-map + (lambda (#{x\ 3097}#) + (if (eq? (car #{x\ 3097}#) 'ref) + (memq (car (cdr #{x\ 3097}#)) + #{formals\ 3088}#) + #f)) + (cdr #{e\ 3082}#)) + (cons 'map + (cons (list 'primitive (car #{e\ 3082}#)) + (map (begin + (let ((#{r\ 3103}# + (map cons + #{formals\ 3088}# + #{actuals\ 3089}#))) + (lambda (#{x\ 3104}#) + (cdr (assq (car (cdr #{x\ 3104}#)) + #{r\ 3103}#))))) + (cdr #{e\ 3082}#)))) + (cons 'map + (cons (list 'lambda + #{formals\ 3088}# + #{e\ 3082}#) + #{actuals\ 3089}#)))))))) + (#{gen-cons\ 2936}# + (lambda (#{x\ 3108}# #{y\ 3109}#) + (begin + (let ((#{atom-key\ 3114}# (car #{y\ 3109}#))) + (if (eqv? #{atom-key\ 3114}# 'quote) + (if (eq? (car #{x\ 3108}#) 'quote) + (list 'quote + (cons (car (cdr #{x\ 3108}#)) + (car (cdr #{y\ 3109}#)))) + (if (eq? (car (cdr #{y\ 3109}#)) '()) + (list 'list #{x\ 3108}#) + (list 'cons #{x\ 3108}# #{y\ 3109}#))) + (if (eqv? #{atom-key\ 3114}# 'list) + (cons 'list (cons #{x\ 3108}# (cdr #{y\ 3109}#))) + (list 'cons #{x\ 3108}# #{y\ 3109}#))))))) + (#{gen-append\ 2938}# + (lambda (#{x\ 3123}# #{y\ 3124}#) + (if (equal? #{y\ 3124}# ''()) + #{x\ 3123}# + (list 'append #{x\ 3123}# #{y\ 3124}#)))) + (#{gen-vector\ 2940}# + (lambda (#{x\ 3128}#) + (if (eq? (car #{x\ 3128}#) 'list) + (cons 'vector (cdr #{x\ 3128}#)) + (if (eq? (car #{x\ 3128}#) 'quote) + (list 'quote + (list->vector (car (cdr #{x\ 3128}#)))) + (list 'list->vector #{x\ 3128}#))))) + (#{regen\ 2942}# + (lambda (#{x\ 3138}#) + (begin + (let ((#{atom-key\ 3142}# (car #{x\ 3138}#))) + (if (eqv? #{atom-key\ 3142}# 'ref) + (#{build-lexical-reference\ 308}# + 'value + #f + (car (cdr #{x\ 3138}#)) + (car (cdr #{x\ 3138}#))) + (if (eqv? #{atom-key\ 3142}# 'primitive) + (#{build-primref\ 326}# + #f + (car (cdr #{x\ 3138}#))) + (if (eqv? #{atom-key\ 3142}# 'quote) + (#{build-data\ 328}# #f (car (cdr #{x\ 3138}#))) + (if (eqv? #{atom-key\ 3142}# 'lambda) + (if (list? (car (cdr #{x\ 3138}#))) + (#{build-simple-lambda\ 320}# + #f + (car (cdr #{x\ 3138}#)) + #f + (car (cdr #{x\ 3138}#)) + '() + (#{regen\ 2942}# + (car (cdr (cdr #{x\ 3138}#))))) + (error "how did we get here" #{x\ 3138}#)) + (#{build-application\ 302}# + #f + (#{build-primref\ 326}# #f (car #{x\ 3138}#)) + (map #{regen\ 2942}# + (cdr #{x\ 3138}#)))))))))))) (begin - (set! $sc-dispatch - (lambda (#{e\ 4185}# #{p\ 4186}#) - (if (eq? #{p\ 4186}# 'any) - (list #{e\ 4185}#) - (if (eq? #{p\ 4186}# '_) - '() - (if (#{syntax-object?\ 346}# #{e\ 4185}#) - (#{match*\ 4007}# - (#{syntax-object-expression\ 348}# #{e\ 4185}#) - #{p\ 4186}# - (#{syntax-object-wrap\ 350}# #{e\ 4185}#) - '() - (#{syntax-object-module\ 352}# #{e\ 4185}#)) - (#{match*\ 4007}# - #{e\ 4185}# - #{p\ 4186}# - '(()) - '() - #f)))))))))))))) + (lambda (#{e\ 3154}# + #{r\ 3155}# + #{w\ 3156}# + #{s\ 3157}# + #{mod\ 3158}#) + (begin + (let ((#{e\ 3165}# + (#{source-wrap\ 444}# + #{e\ 3154}# + #{w\ 3156}# + #{s\ 3157}# + #{mod\ 3158}#))) + (let ((#{tmp\ 3166}# #{e\ 3165}#)) + (let ((#{tmp\ 3167}# + ($sc-dispatch #{tmp\ 3166}# '(_ any)))) + (if #{tmp\ 3167}# + (@apply + (lambda (#{x\ 3169}#) + (call-with-values + (lambda () + (#{gen-syntax\ 2928}# + #{e\ 3165}# + #{x\ 3169}# + #{r\ 3155}# + '() + #{ellipsis?\ 472}# + #{mod\ 3158}#)) + (lambda (#{e\ 3170}# #{maps\ 3171}#) + (#{regen\ 2942}# #{e\ 3170}#)))) + #{tmp\ 3167}#) + (let ((#{_\ 3175}# #{tmp\ 3166}#)) + (syntax-violation + 'syntax + "bad `syntax' form" + #{e\ 3165}#))))))))))) + (#{global-extend\ 372}# + 'core + 'lambda + (lambda (#{e\ 3176}# + #{r\ 3177}# + #{w\ 3178}# + #{s\ 3179}# + #{mod\ 3180}#) + (let ((#{tmp\ 3186}# #{e\ 3176}#)) + (let ((#{tmp\ 3187}# + ($sc-dispatch + #{tmp\ 3186}# + '(_ any any . each-any)))) + (if #{tmp\ 3187}# + (@apply + (lambda (#{args\ 3191}# #{e1\ 3192}# #{e2\ 3193}#) + (call-with-values + (lambda () + (#{lambda-formals\ 474}# #{args\ 3191}#)) + (lambda (#{req\ 3194}# + #{opt\ 3195}# + #{rest\ 3196}# + #{kw\ 3197}#) + (letrec* + ((#{lp\ 3205}# + (lambda (#{body\ 3206}# #{meta\ 3207}#) + (let ((#{tmp\ 3209}# #{body\ 3206}#)) + (let ((#{tmp\ 3210}# + ($sc-dispatch + #{tmp\ 3209}# + '(any any . each-any)))) + (if (if #{tmp\ 3210}# + (@apply + (lambda (#{docstring\ 3214}# + #{e1\ 3215}# + #{e2\ 3216}#) + (string? + (syntax->datum + #{docstring\ 3214}#))) + #{tmp\ 3210}#) + #f) + (@apply + (lambda (#{docstring\ 3220}# + #{e1\ 3221}# + #{e2\ 3222}#) + (#{lp\ 3205}# + (cons #{e1\ 3221}# #{e2\ 3222}#) + (append + #{meta\ 3207}# + (list (cons 'documentation + (syntax->datum + #{docstring\ 3220}#)))))) + #{tmp\ 3210}#) + (let ((#{tmp\ 3225}# + ($sc-dispatch + #{tmp\ 3209}# + '(#(vector + #(each (any . any))) + any + . + each-any)))) + (if #{tmp\ 3225}# + (@apply + (lambda (#{k\ 3230}# + #{v\ 3231}# + #{e1\ 3232}# + #{e2\ 3233}#) + (#{lp\ 3205}# + (cons #{e1\ 3232}# + #{e2\ 3233}#) + (append + #{meta\ 3207}# + (syntax->datum + (map cons + #{k\ 3230}# + #{v\ 3231}#))))) + #{tmp\ 3225}#) + (let ((#{_\ 3238}# #{tmp\ 3209}#)) + (#{chi-simple-lambda\ 476}# + #{e\ 3176}# + #{r\ 3177}# + #{w\ 3178}# + #{s\ 3179}# + #{mod\ 3180}# + #{req\ 3194}# + #{rest\ 3196}# + #{meta\ 3207}# + #{body\ 3206}#)))))))))) + (begin + (#{lp\ 3205}# + (cons #{e1\ 3192}# #{e2\ 3193}#) + '())))))) + #{tmp\ 3187}#) + (let ((#{_\ 3240}# #{tmp\ 3186}#)) + (syntax-violation + 'lambda + "bad lambda" + #{e\ 3176}#))))))) + (#{global-extend\ 372}# + 'core + 'lambda* + (lambda (#{e\ 3241}# + #{r\ 3242}# + #{w\ 3243}# + #{s\ 3244}# + #{mod\ 3245}#) + (let ((#{tmp\ 3251}# #{e\ 3241}#)) + (let ((#{tmp\ 3252}# + ($sc-dispatch + #{tmp\ 3251}# + '(_ any any . each-any)))) + (if #{tmp\ 3252}# + (@apply + (lambda (#{args\ 3256}# #{e1\ 3257}# #{e2\ 3258}#) + (call-with-values + (lambda () + (#{chi-lambda-case\ 480}# + #{e\ 3241}# + #{r\ 3242}# + #{w\ 3243}# + #{s\ 3244}# + #{mod\ 3245}# + #{lambda*-formals\ 478}# + (list (cons #{args\ 3256}# + (cons #{e1\ 3257}# #{e2\ 3258}#))))) + (lambda (#{meta\ 3260}# #{lcase\ 3261}#) + (#{build-case-lambda\ 322}# + #{s\ 3244}# + #{meta\ 3260}# + #{lcase\ 3261}#)))) + #{tmp\ 3252}#) + (let ((#{_\ 3265}# #{tmp\ 3251}#)) + (syntax-violation + 'lambda + "bad lambda*" + #{e\ 3241}#))))))) + (#{global-extend\ 372}# + 'core + 'case-lambda + (lambda (#{e\ 3266}# + #{r\ 3267}# + #{w\ 3268}# + #{s\ 3269}# + #{mod\ 3270}#) + (let ((#{tmp\ 3276}# #{e\ 3266}#)) + (let ((#{tmp\ 3277}# + ($sc-dispatch + #{tmp\ 3276}# + '(_ (any any . each-any) + . + #(each (any any . each-any)))))) + (if #{tmp\ 3277}# + (@apply + (lambda (#{args\ 3284}# + #{e1\ 3285}# + #{e2\ 3286}# + #{args*\ 3287}# + #{e1*\ 3288}# + #{e2*\ 3289}#) + (call-with-values + (lambda () + (#{chi-lambda-case\ 480}# + #{e\ 3266}# + #{r\ 3267}# + #{w\ 3268}# + #{s\ 3269}# + #{mod\ 3270}# + #{lambda-formals\ 474}# + (cons (cons #{args\ 3284}# + (cons #{e1\ 3285}# #{e2\ 3286}#)) + (map (lambda (#{tmp\ 3293}# + #{tmp\ 3292}# + #{tmp\ 3291}#) + (cons #{tmp\ 3291}# + (cons #{tmp\ 3292}# + #{tmp\ 3293}#))) + #{e2*\ 3289}# + #{e1*\ 3288}# + #{args*\ 3287}#)))) + (lambda (#{meta\ 3295}# #{lcase\ 3296}#) + (#{build-case-lambda\ 322}# + #{s\ 3269}# + #{meta\ 3295}# + #{lcase\ 3296}#)))) + #{tmp\ 3277}#) + (let ((#{_\ 3300}# #{tmp\ 3276}#)) + (syntax-violation + 'case-lambda + "bad case-lambda" + #{e\ 3266}#))))))) + (#{global-extend\ 372}# + 'core + 'case-lambda* + (lambda (#{e\ 3301}# + #{r\ 3302}# + #{w\ 3303}# + #{s\ 3304}# + #{mod\ 3305}#) + (let ((#{tmp\ 3311}# #{e\ 3301}#)) + (let ((#{tmp\ 3312}# + ($sc-dispatch + #{tmp\ 3311}# + '(_ (any any . each-any) + . + #(each (any any . each-any)))))) + (if #{tmp\ 3312}# + (@apply + (lambda (#{args\ 3319}# + #{e1\ 3320}# + #{e2\ 3321}# + #{args*\ 3322}# + #{e1*\ 3323}# + #{e2*\ 3324}#) + (call-with-values + (lambda () + (#{chi-lambda-case\ 480}# + #{e\ 3301}# + #{r\ 3302}# + #{w\ 3303}# + #{s\ 3304}# + #{mod\ 3305}# + #{lambda*-formals\ 478}# + (cons (cons #{args\ 3319}# + (cons #{e1\ 3320}# #{e2\ 3321}#)) + (map (lambda (#{tmp\ 3328}# + #{tmp\ 3327}# + #{tmp\ 3326}#) + (cons #{tmp\ 3326}# + (cons #{tmp\ 3327}# + #{tmp\ 3328}#))) + #{e2*\ 3324}# + #{e1*\ 3323}# + #{args*\ 3322}#)))) + (lambda (#{meta\ 3330}# #{lcase\ 3331}#) + (#{build-case-lambda\ 322}# + #{s\ 3304}# + #{meta\ 3330}# + #{lcase\ 3331}#)))) + #{tmp\ 3312}#) + (let ((#{_\ 3335}# #{tmp\ 3311}#)) + (syntax-violation + 'case-lambda + "bad case-lambda*" + #{e\ 3301}#))))))) + (#{global-extend\ 372}# + 'core + 'let + (letrec* + ((#{chi-let\ 3337}# + (lambda (#{e\ 3338}# + #{r\ 3339}# + #{w\ 3340}# + #{s\ 3341}# + #{mod\ 3342}# + #{constructor\ 3343}# + #{ids\ 3344}# + #{vals\ 3345}# + #{exps\ 3346}#) + (if (not (#{valid-bound-ids?\ 436}# #{ids\ 3344}#)) + (syntax-violation + 'let + "duplicate bound variable" + #{e\ 3338}#) + (begin + (let ((#{labels\ 3358}# + (#{gen-labels\ 391}# #{ids\ 3344}#)) + (#{new-vars\ 3359}# + (map #{gen-var\ 484}# #{ids\ 3344}#))) + (begin + (let ((#{nw\ 3362}# + (#{make-binding-wrap\ 420}# + #{ids\ 3344}# + #{labels\ 3358}# + #{w\ 3340}#)) + (#{nr\ 3363}# + (#{extend-var-env\ 366}# + #{labels\ 3358}# + #{new-vars\ 3359}# + #{r\ 3339}#))) + (#{constructor\ 3343}# + #{s\ 3341}# + (map syntax->datum #{ids\ 3344}#) + #{new-vars\ 3359}# + (map (lambda (#{x\ 3364}#) + (#{chi\ 456}# + #{x\ 3364}# + #{r\ 3339}# + #{w\ 3340}# + #{mod\ 3342}#)) + #{vals\ 3345}#) + (#{chi-body\ 464}# + #{exps\ 3346}# + (#{source-wrap\ 444}# + #{e\ 3338}# + #{nw\ 3362}# + #{s\ 3341}# + #{mod\ 3342}#) + #{nr\ 3363}# + #{nw\ 3362}# + #{mod\ 3342}#)))))))))) + (begin + (lambda (#{e\ 3366}# + #{r\ 3367}# + #{w\ 3368}# + #{s\ 3369}# + #{mod\ 3370}#) + (let ((#{tmp\ 3376}# #{e\ 3366}#)) + (let ((#{tmp\ 3377}# + ($sc-dispatch + #{tmp\ 3376}# + '(_ #(each (any any)) any . each-any)))) + (if (if #{tmp\ 3377}# + (@apply + (lambda (#{id\ 3382}# + #{val\ 3383}# + #{e1\ 3384}# + #{e2\ 3385}#) + (and-map #{id?\ 376}# #{id\ 3382}#)) + #{tmp\ 3377}#) + #f) + (@apply + (lambda (#{id\ 3391}# + #{val\ 3392}# + #{e1\ 3393}# + #{e2\ 3394}#) + (#{chi-let\ 3337}# + #{e\ 3366}# + #{r\ 3367}# + #{w\ 3368}# + #{s\ 3369}# + #{mod\ 3370}# + #{build-let\ 332}# + #{id\ 3391}# + #{val\ 3392}# + (cons #{e1\ 3393}# #{e2\ 3394}#))) + #{tmp\ 3377}#) + (let ((#{tmp\ 3398}# + ($sc-dispatch + #{tmp\ 3376}# + '(_ any #(each (any any)) any . each-any)))) + (if (if #{tmp\ 3398}# + (@apply + (lambda (#{f\ 3404}# + #{id\ 3405}# + #{val\ 3406}# + #{e1\ 3407}# + #{e2\ 3408}#) + (if (#{id?\ 376}# #{f\ 3404}#) + (and-map #{id?\ 376}# #{id\ 3405}#) + #f)) + #{tmp\ 3398}#) + #f) + (@apply + (lambda (#{f\ 3417}# + #{id\ 3418}# + #{val\ 3419}# + #{e1\ 3420}# + #{e2\ 3421}#) + (#{chi-let\ 3337}# + #{e\ 3366}# + #{r\ 3367}# + #{w\ 3368}# + #{s\ 3369}# + #{mod\ 3370}# + #{build-named-let\ 334}# + (cons #{f\ 3417}# #{id\ 3418}#) + #{val\ 3419}# + (cons #{e1\ 3420}# #{e2\ 3421}#))) + #{tmp\ 3398}#) + (let ((#{_\ 3426}# #{tmp\ 3376}#)) + (syntax-violation + 'let + "bad let" + (#{source-wrap\ 444}# + #{e\ 3366}# + #{w\ 3368}# + #{s\ 3369}# + #{mod\ 3370}#)))))))))))) + (#{global-extend\ 372}# + 'core + 'letrec + (lambda (#{e\ 3427}# + #{r\ 3428}# + #{w\ 3429}# + #{s\ 3430}# + #{mod\ 3431}#) + (let ((#{tmp\ 3437}# #{e\ 3427}#)) + (let ((#{tmp\ 3438}# + ($sc-dispatch + #{tmp\ 3437}# + '(_ #(each (any any)) any . each-any)))) + (if (if #{tmp\ 3438}# + (@apply + (lambda (#{id\ 3443}# + #{val\ 3444}# + #{e1\ 3445}# + #{e2\ 3446}#) + (and-map #{id?\ 376}# #{id\ 3443}#)) + #{tmp\ 3438}#) + #f) + (@apply + (lambda (#{id\ 3452}# + #{val\ 3453}# + #{e1\ 3454}# + #{e2\ 3455}#) + (begin + (let ((#{ids\ 3457}# #{id\ 3452}#)) + (if (not (#{valid-bound-ids?\ 436}# #{ids\ 3457}#)) + (syntax-violation + 'letrec + "duplicate bound variable" + #{e\ 3427}#) + (begin + (let ((#{labels\ 3461}# + (#{gen-labels\ 391}# #{ids\ 3457}#)) + (#{new-vars\ 3462}# + (map #{gen-var\ 484}# #{ids\ 3457}#))) + (begin + (let ((#{w\ 3465}# + (#{make-binding-wrap\ 420}# + #{ids\ 3457}# + #{labels\ 3461}# + #{w\ 3429}#)) + (#{r\ 3466}# + (#{extend-var-env\ 366}# + #{labels\ 3461}# + #{new-vars\ 3462}# + #{r\ 3428}#))) + (#{build-letrec\ 336}# + #{s\ 3430}# + #f + (map syntax->datum #{ids\ 3457}#) + #{new-vars\ 3462}# + (map (lambda (#{x\ 3467}#) + (#{chi\ 456}# + #{x\ 3467}# + #{r\ 3466}# + #{w\ 3465}# + #{mod\ 3431}#)) + #{val\ 3453}#) + (#{chi-body\ 464}# + (cons #{e1\ 3454}# #{e2\ 3455}#) + (#{source-wrap\ 444}# + #{e\ 3427}# + #{w\ 3465}# + #{s\ 3430}# + #{mod\ 3431}#) + #{r\ 3466}# + #{w\ 3465}# + #{mod\ 3431}#)))))))))) + #{tmp\ 3438}#) + (let ((#{_\ 3472}# #{tmp\ 3437}#)) + (syntax-violation + 'letrec + "bad letrec" + (#{source-wrap\ 444}# + #{e\ 3427}# + #{w\ 3429}# + #{s\ 3430}# + #{mod\ 3431}#)))))))) + (#{global-extend\ 372}# + 'core + 'letrec* + (lambda (#{e\ 3473}# + #{r\ 3474}# + #{w\ 3475}# + #{s\ 3476}# + #{mod\ 3477}#) + (let ((#{tmp\ 3483}# #{e\ 3473}#)) + (let ((#{tmp\ 3484}# + ($sc-dispatch + #{tmp\ 3483}# + '(_ #(each (any any)) any . each-any)))) + (if (if #{tmp\ 3484}# + (@apply + (lambda (#{id\ 3489}# + #{val\ 3490}# + #{e1\ 3491}# + #{e2\ 3492}#) + (and-map #{id?\ 376}# #{id\ 3489}#)) + #{tmp\ 3484}#) + #f) + (@apply + (lambda (#{id\ 3498}# + #{val\ 3499}# + #{e1\ 3500}# + #{e2\ 3501}#) + (begin + (let ((#{ids\ 3503}# #{id\ 3498}#)) + (if (not (#{valid-bound-ids?\ 436}# #{ids\ 3503}#)) + (syntax-violation + 'letrec* + "duplicate bound variable" + #{e\ 3473}#) + (begin + (let ((#{labels\ 3507}# + (#{gen-labels\ 391}# #{ids\ 3503}#)) + (#{new-vars\ 3508}# + (map #{gen-var\ 484}# #{ids\ 3503}#))) + (begin + (let ((#{w\ 3511}# + (#{make-binding-wrap\ 420}# + #{ids\ 3503}# + #{labels\ 3507}# + #{w\ 3475}#)) + (#{r\ 3512}# + (#{extend-var-env\ 366}# + #{labels\ 3507}# + #{new-vars\ 3508}# + #{r\ 3474}#))) + (#{build-letrec\ 336}# + #{s\ 3476}# + #t + (map syntax->datum #{ids\ 3503}#) + #{new-vars\ 3508}# + (map (lambda (#{x\ 3513}#) + (#{chi\ 456}# + #{x\ 3513}# + #{r\ 3512}# + #{w\ 3511}# + #{mod\ 3477}#)) + #{val\ 3499}#) + (#{chi-body\ 464}# + (cons #{e1\ 3500}# #{e2\ 3501}#) + (#{source-wrap\ 444}# + #{e\ 3473}# + #{w\ 3511}# + #{s\ 3476}# + #{mod\ 3477}#) + #{r\ 3512}# + #{w\ 3511}# + #{mod\ 3477}#)))))))))) + #{tmp\ 3484}#) + (let ((#{_\ 3518}# #{tmp\ 3483}#)) + (syntax-violation + 'letrec* + "bad letrec*" + (#{source-wrap\ 444}# + #{e\ 3473}# + #{w\ 3475}# + #{s\ 3476}# + #{mod\ 3477}#)))))))) + (#{global-extend\ 372}# + 'core + 'set! + (lambda (#{e\ 3519}# + #{r\ 3520}# + #{w\ 3521}# + #{s\ 3522}# + #{mod\ 3523}#) + (let ((#{tmp\ 3529}# #{e\ 3519}#)) + (let ((#{tmp\ 3530}# + ($sc-dispatch #{tmp\ 3529}# '(_ any any)))) + (if (if #{tmp\ 3530}# + (@apply + (lambda (#{id\ 3533}# #{val\ 3534}#) + (#{id?\ 376}# #{id\ 3533}#)) + #{tmp\ 3530}#) + #f) + (@apply + (lambda (#{id\ 3537}# #{val\ 3538}#) + (begin + (let ((#{n\ 3541}# + (#{id-var-name\ 430}# + #{id\ 3537}# + #{w\ 3521}#)) + (#{id-mod\ 3542}# + (if (#{syntax-object?\ 342}# #{id\ 3537}#) + (#{syntax-object-module\ 348}# + #{id\ 3537}#) + #{mod\ 3523}#))) + (begin + (let ((#{b\ 3544}# + (#{lookup\ 370}# + #{n\ 3541}# + #{r\ 3520}# + #{id-mod\ 3542}#))) + (begin + (let ((#{atom-key\ 3547}# (car #{b\ 3544}#))) + (if (eqv? #{atom-key\ 3547}# 'lexical) + (#{build-lexical-assignment\ 310}# + #{s\ 3522}# + (syntax->datum #{id\ 3537}#) + (cdr #{b\ 3544}#) + (#{chi\ 456}# + #{val\ 3538}# + #{r\ 3520}# + #{w\ 3521}# + #{mod\ 3523}#)) + (if (eqv? #{atom-key\ 3547}# 'global) + (#{build-global-assignment\ 316}# + #{s\ 3522}# + #{n\ 3541}# + (#{chi\ 456}# + #{val\ 3538}# + #{r\ 3520}# + #{w\ 3521}# + #{mod\ 3523}#) + #{id-mod\ 3542}#) + (if (eqv? #{atom-key\ 3547}# 'macro) + (begin + (let ((#{p\ 3554}# + (cdr #{b\ 3544}#))) + (if (procedure-property + #{p\ 3554}# + 'variable-transformer) + (#{chi\ 456}# + (#{chi-macro\ 462}# + #{p\ 3554}# + #{e\ 3519}# + #{r\ 3520}# + #{w\ 3521}# + #{s\ 3522}# + #f + #{mod\ 3523}#) + #{r\ 3520}# + '(()) + #{mod\ 3523}#) + (syntax-violation + 'set! + "not a variable transformer" + (#{wrap\ 442}# + #{e\ 3519}# + #{w\ 3521}# + #{mod\ 3523}#) + (#{wrap\ 442}# + #{id\ 3537}# + #{w\ 3521}# + #{id-mod\ 3542}#))))) + (if (eqv? #{atom-key\ 3547}# + 'displaced-lexical) + (syntax-violation + 'set! + "identifier out of context" + (#{wrap\ 442}# + #{id\ 3537}# + #{w\ 3521}# + #{mod\ 3523}#)) + (syntax-violation + 'set! + "bad set!" + (#{source-wrap\ 444}# + #{e\ 3519}# + #{w\ 3521}# + #{s\ 3522}# + #{mod\ 3523}#))))))))))))) + #{tmp\ 3530}#) + (let ((#{tmp\ 3559}# + ($sc-dispatch + #{tmp\ 3529}# + '(_ (any . each-any) any)))) + (if #{tmp\ 3559}# + (@apply + (lambda (#{head\ 3563}# #{tail\ 3564}# #{val\ 3565}#) + (call-with-values + (lambda () + (#{syntax-type\ 454}# + #{head\ 3563}# + #{r\ 3520}# + '(()) + #f + #f + #{mod\ 3523}# + #t)) + (lambda (#{type\ 3568}# + #{value\ 3569}# + #{ee\ 3570}# + #{ww\ 3571}# + #{ss\ 3572}# + #{modmod\ 3573}#) + (if (eqv? #{type\ 3568}# 'module-ref) + (begin + (let ((#{val\ 3582}# + (#{chi\ 456}# + #{val\ 3565}# + #{r\ 3520}# + #{w\ 3521}# + #{mod\ 3523}#))) + (call-with-values + (lambda () + (#{value\ 3569}# + (cons #{head\ 3563}# + #{tail\ 3564}#) + #{r\ 3520}# + #{w\ 3521}#)) + (lambda (#{e\ 3584}# + #{r\ 3585}# + #{w\ 3586}# + #{s*\ 3587}# + #{mod\ 3588}#) + (let ((#{tmp\ 3594}# #{e\ 3584}#)) + (let ((#{tmp\ 3595}# + (list #{tmp\ 3594}#))) + (if (if #{tmp\ 3595}# + (@apply + (lambda (#{e\ 3597}#) + (#{id?\ 376}# + #{e\ 3597}#)) + #{tmp\ 3595}#) + #f) + (@apply + (lambda (#{e\ 3599}#) + (#{build-global-assignment\ 316}# + #{s\ 3522}# + (syntax->datum + #{e\ 3599}#) + #{val\ 3582}# + #{mod\ 3588}#)) + #{tmp\ 3595}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 3594}#)))))))) + (#{build-application\ 302}# + #{s\ 3522}# + (#{chi\ 456}# + (list '#(syntax-object + setter + ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(type value ee ww ss modmod) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("i3574" + "i3575" + "i3576" + "i3577" + "i3578" + "i3579")) + #(ribcage + #(head tail val) + #((top) (top) (top)) + #("i3560" "i3561" "i3562")) + #(ribcage () () ()) + #(ribcage + #(e r w s mod) + #((top) + (top) + (top) + (top) + (top)) + #("i3524" + "i3525" + "i3526" + "i3527" + "i3528")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile)) + #{head\ 3563}#) + #{r\ 3520}# + #{w\ 3521}# + #{mod\ 3523}#) + (map (lambda (#{e\ 3601}#) + (#{chi\ 456}# + #{e\ 3601}# + #{r\ 3520}# + #{w\ 3521}# + #{mod\ 3523}#)) + (append + #{tail\ 3564}# + (list #{val\ 3565}#)))))))) + #{tmp\ 3559}#) + (let ((#{_\ 3605}# #{tmp\ 3529}#)) + (syntax-violation + 'set! + "bad set!" + (#{source-wrap\ 444}# + #{e\ 3519}# + #{w\ 3521}# + #{s\ 3522}# + #{mod\ 3523}#)))))))))) + (#{global-extend\ 372}# + 'module-ref + '@ + (lambda (#{e\ 3606}# #{r\ 3607}# #{w\ 3608}#) + (let ((#{tmp\ 3612}# #{e\ 3606}#)) + (let ((#{tmp\ 3613}# + ($sc-dispatch #{tmp\ 3612}# '(_ each-any any)))) + (if (if #{tmp\ 3613}# + (@apply + (lambda (#{mod\ 3616}# #{id\ 3617}#) + (if (and-map #{id?\ 376}# #{mod\ 3616}#) + (#{id?\ 376}# #{id\ 3617}#) + #f)) + #{tmp\ 3613}#) + #f) + (@apply + (lambda (#{mod\ 3623}# #{id\ 3624}#) + (values + (syntax->datum #{id\ 3624}#) + #{r\ 3607}# + #{w\ 3608}# + #f + (syntax->datum + (cons '#(syntax-object + public + ((top) + #(ribcage + #(mod id) + #((top) (top)) + #("i3621" "i3622")) + #(ribcage () () ()) + #(ribcage + #(e r w) + #((top) (top) (top)) + #("i3609" "i3610" "i3611")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile)) + #{mod\ 3623}#)))) + #{tmp\ 3613}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 3612}#)))))) + (#{global-extend\ 372}# + 'module-ref + '@@ + (lambda (#{e\ 3626}# #{r\ 3627}# #{w\ 3628}#) + (letrec* + ((#{remodulate\ 3633}# + (lambda (#{x\ 3634}# #{mod\ 3635}#) + (if (pair? #{x\ 3634}#) + (cons (#{remodulate\ 3633}# + (car #{x\ 3634}#) + #{mod\ 3635}#) + (#{remodulate\ 3633}# + (cdr #{x\ 3634}#) + #{mod\ 3635}#)) + (if (#{syntax-object?\ 342}# #{x\ 3634}#) + (#{make-syntax-object\ 340}# + (#{remodulate\ 3633}# + (#{syntax-object-expression\ 344}# #{x\ 3634}#) + #{mod\ 3635}#) + (#{syntax-object-wrap\ 346}# #{x\ 3634}#) + #{mod\ 3635}#) + (if (vector? #{x\ 3634}#) + (begin + (let ((#{n\ 3646}# (vector-length #{x\ 3634}#))) + (begin + (let ((#{v\ 3648}# (make-vector #{n\ 3646}#))) + (letrec* + ((#{loop\ 3651}# + (lambda (#{i\ 3652}#) + (if (= #{i\ 3652}# #{n\ 3646}#) + (begin (if #f #f) #{v\ 3648}#) + (begin + (vector-set! + #{v\ 3648}# + #{i\ 3652}# + (#{remodulate\ 3633}# + (vector-ref + #{x\ 3634}# + #{i\ 3652}#) + #{mod\ 3635}#)) + (#{loop\ 3651}# + (1+ #{i\ 3652}#))))))) + (begin (#{loop\ 3651}# 0))))))) + #{x\ 3634}#)))))) + (begin + (let ((#{tmp\ 3658}# #{e\ 3626}#)) + (let ((#{tmp\ 3659}# + ($sc-dispatch #{tmp\ 3658}# '(_ each-any any)))) + (if (if #{tmp\ 3659}# + (@apply + (lambda (#{mod\ 3662}# #{exp\ 3663}#) + (and-map #{id?\ 376}# #{mod\ 3662}#)) + #{tmp\ 3659}#) + #f) + (@apply + (lambda (#{mod\ 3667}# #{exp\ 3668}#) + (begin + (let ((#{mod\ 3670}# + (syntax->datum + (cons '#(syntax-object + private + ((top) + #(ribcage + #(mod exp) + #((top) (top)) + #("i3665" "i3666")) + #(ribcage + (remodulate) + ((top)) + ("i3632")) + #(ribcage + #(e r w) + #((top) (top) (top)) + #("i3629" "i3630" "i3631")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile)) + #{mod\ 3667}#)))) + (values + (#{remodulate\ 3633}# + #{exp\ 3668}# + #{mod\ 3670}#) + #{r\ 3627}# + #{w\ 3628}# + (#{source-annotation\ 357}# #{exp\ 3668}#) + #{mod\ 3670}#)))) + #{tmp\ 3659}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 3658}#)))))))) + (#{global-extend\ 372}# + 'core + 'if + (lambda (#{e\ 3672}# + #{r\ 3673}# + #{w\ 3674}# + #{s\ 3675}# + #{mod\ 3676}#) + (let ((#{tmp\ 3682}# #{e\ 3672}#)) + (let ((#{tmp\ 3683}# + ($sc-dispatch #{tmp\ 3682}# '(_ any any)))) + (if #{tmp\ 3683}# + (@apply + (lambda (#{test\ 3686}# #{then\ 3687}#) + (#{build-conditional\ 304}# + #{s\ 3675}# + (#{chi\ 456}# + #{test\ 3686}# + #{r\ 3673}# + #{w\ 3674}# + #{mod\ 3676}#) + (#{chi\ 456}# + #{then\ 3687}# + #{r\ 3673}# + #{w\ 3674}# + #{mod\ 3676}#) + (#{build-void\ 300}# #f))) + #{tmp\ 3683}#) + (let ((#{tmp\ 3689}# + ($sc-dispatch #{tmp\ 3682}# '(_ any any any)))) + (if #{tmp\ 3689}# + (@apply + (lambda (#{test\ 3693}# + #{then\ 3694}# + #{else\ 3695}#) + (#{build-conditional\ 304}# + #{s\ 3675}# + (#{chi\ 456}# + #{test\ 3693}# + #{r\ 3673}# + #{w\ 3674}# + #{mod\ 3676}#) + (#{chi\ 456}# + #{then\ 3694}# + #{r\ 3673}# + #{w\ 3674}# + #{mod\ 3676}#) + (#{chi\ 456}# + #{else\ 3695}# + #{r\ 3673}# + #{w\ 3674}# + #{mod\ 3676}#))) + #{tmp\ 3689}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 3682}#)))))))) + (#{global-extend\ 372}# + 'core + 'with-fluids + (lambda (#{e\ 3696}# + #{r\ 3697}# + #{w\ 3698}# + #{s\ 3699}# + #{mod\ 3700}#) + (let ((#{tmp\ 3706}# #{e\ 3696}#)) + (let ((#{tmp\ 3707}# + ($sc-dispatch + #{tmp\ 3706}# + '(_ #(each (any any)) any . each-any)))) + (if #{tmp\ 3707}# + (@apply + (lambda (#{fluid\ 3712}# + #{val\ 3713}# + #{b\ 3714}# + #{b*\ 3715}#) + (#{build-dynlet\ 306}# + #{s\ 3699}# + (map (lambda (#{x\ 3716}#) + (#{chi\ 456}# + #{x\ 3716}# + #{r\ 3697}# + #{w\ 3698}# + #{mod\ 3700}#)) + #{fluid\ 3712}#) + (map (lambda (#{x\ 3719}#) + (#{chi\ 456}# + #{x\ 3719}# + #{r\ 3697}# + #{w\ 3698}# + #{mod\ 3700}#)) + #{val\ 3713}#) + (#{chi-body\ 464}# + (cons #{b\ 3714}# #{b*\ 3715}#) + (#{source-wrap\ 444}# + #{e\ 3696}# + #{w\ 3698}# + #{s\ 3699}# + #{mod\ 3700}#) + #{r\ 3697}# + #{w\ 3698}# + #{mod\ 3700}#))) + #{tmp\ 3707}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 3706}#)))))) + (#{global-extend\ 372}# 'begin 'begin '()) + (#{global-extend\ 372}# 'define 'define '()) + (#{global-extend\ 372}# + 'define-syntax + 'define-syntax + '()) + (#{global-extend\ 372}# + 'eval-when + 'eval-when + '()) + (#{global-extend\ 372}# + 'core + 'syntax-case + (letrec* + ((#{convert-pattern\ 3724}# + (lambda (#{pattern\ 3731}# #{keys\ 3732}#) + (letrec* + ((#{cvt*\ 3736}# + (lambda (#{p*\ 3739}# #{n\ 3740}# #{ids\ 3741}#) + (if (null? #{p*\ 3739}#) + (values '() #{ids\ 3741}#) + (call-with-values + (lambda () + (#{cvt*\ 3736}# + (cdr #{p*\ 3739}#) + #{n\ 3740}# + #{ids\ 3741}#)) + (lambda (#{y\ 3745}# #{ids\ 3746}#) + (call-with-values + (lambda () + (#{cvt\ 3738}# + (car #{p*\ 3739}#) + #{n\ 3740}# + #{ids\ 3746}#)) + (lambda (#{x\ 3749}# #{ids\ 3750}#) + (values + (cons #{x\ 3749}# #{y\ 3745}#) + #{ids\ 3750}#)))))))) + (#{cvt\ 3738}# + (lambda (#{p\ 3753}# #{n\ 3754}# #{ids\ 3755}#) + (if (#{id?\ 376}# #{p\ 3753}#) + (if (#{bound-id-member?\ 440}# + #{p\ 3753}# + #{keys\ 3732}#) + (values + (vector 'free-id #{p\ 3753}#) + #{ids\ 3755}#) + (if (#{free-id=?\ 432}# + #{p\ 3753}# + '#(syntax-object + _ + ((top) + #(ribcage () () ()) + #(ribcage + #(p n ids) + #((top) (top) (top)) + #("i3756" "i3757" "i3758")) + #(ribcage + (cvt cvt*) + ((top) (top)) + ("i3737" "i3735")) + #(ribcage + #(pattern keys) + #((top) (top)) + #("i3733" "i3734")) + #(ribcage + (gen-syntax-case + gen-clause + build-dispatch-call + convert-pattern) + ((top) (top) (top) (top)) + ("i3729" "i3727" "i3725" "i3723")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile))) + (values '_ #{ids\ 3755}#) + (values + 'any + (cons (cons #{p\ 3753}# #{n\ 3754}#) + #{ids\ 3755}#)))) + (let ((#{tmp\ 3764}# #{p\ 3753}#)) + (let ((#{tmp\ 3765}# + ($sc-dispatch #{tmp\ 3764}# '(any any)))) + (if (if #{tmp\ 3765}# + (@apply + (lambda (#{x\ 3768}# #{dots\ 3769}#) + (#{ellipsis?\ 472}# #{dots\ 3769}#)) + #{tmp\ 3765}#) + #f) + (@apply + (lambda (#{x\ 3772}# #{dots\ 3773}#) + (call-with-values + (lambda () + (#{cvt\ 3738}# + #{x\ 3772}# + (1+ #{n\ 3754}#) + #{ids\ 3755}#)) + (lambda (#{p\ 3775}# #{ids\ 3776}#) + (values + (if (eq? #{p\ 3775}# 'any) + 'each-any + (vector 'each #{p\ 3775}#)) + #{ids\ 3776}#)))) + #{tmp\ 3765}#) + (let ((#{tmp\ 3779}# + ($sc-dispatch + #{tmp\ 3764}# + '(any any . each-any)))) + (if (if #{tmp\ 3779}# + (@apply + (lambda (#{x\ 3783}# + #{dots\ 3784}# + #{ys\ 3785}#) + (#{ellipsis?\ 472}# + #{dots\ 3784}#)) + #{tmp\ 3779}#) + #f) + (@apply + (lambda (#{x\ 3789}# + #{dots\ 3790}# + #{ys\ 3791}#) + (call-with-values + (lambda () + (#{cvt*\ 3736}# + #{ys\ 3791}# + #{n\ 3754}# + #{ids\ 3755}#)) + (lambda (#{ys\ 3793}# + #{ids\ 3794}#) + (call-with-values + (lambda () + (#{cvt\ 3738}# + #{x\ 3789}# + (1+ #{n\ 3754}#) + #{ids\ 3794}#)) + (lambda (#{x\ 3797}# + #{ids\ 3798}#) + (values + (vector + 'each+ + #{x\ 3797}# + (reverse #{ys\ 3793}#) + '()) + #{ids\ 3798}#)))))) + #{tmp\ 3779}#) + (let ((#{tmp\ 3802}# + ($sc-dispatch + #{tmp\ 3764}# + '(any . any)))) + (if #{tmp\ 3802}# + (@apply + (lambda (#{x\ 3805}# #{y\ 3806}#) + (call-with-values + (lambda () + (#{cvt\ 3738}# + #{y\ 3806}# + #{n\ 3754}# + #{ids\ 3755}#)) + (lambda (#{y\ 3807}# + #{ids\ 3808}#) + (call-with-values + (lambda () + (#{cvt\ 3738}# + #{x\ 3805}# + #{n\ 3754}# + #{ids\ 3808}#)) + (lambda (#{x\ 3811}# + #{ids\ 3812}#) + (values + (cons #{x\ 3811}# + #{y\ 3807}#) + #{ids\ 3812}#)))))) + #{tmp\ 3802}#) + (let ((#{tmp\ 3815}# + ($sc-dispatch + #{tmp\ 3764}# + '()))) + (if #{tmp\ 3815}# + (@apply + (lambda () + (values '() #{ids\ 3755}#)) + #{tmp\ 3815}#) + (let ((#{tmp\ 3816}# + ($sc-dispatch + #{tmp\ 3764}# + '#(vector each-any)))) + (if #{tmp\ 3816}# + (@apply + (lambda (#{x\ 3818}#) + (call-with-values + (lambda () + (#{cvt\ 3738}# + #{x\ 3818}# + #{n\ 3754}# + #{ids\ 3755}#)) + (lambda (#{p\ 3820}# + #{ids\ 3821}#) + (values + (vector + 'vector + #{p\ 3820}#) + #{ids\ 3821}#)))) + #{tmp\ 3816}#) + (let ((#{x\ 3825}# + #{tmp\ 3764}#)) + (values + (vector + 'atom + (#{strip\ 482}# + #{p\ 3753}# + '(()))) + #{ids\ 3755}#))))))))))))))))) + (begin (#{cvt\ 3738}# #{pattern\ 3731}# 0 '()))))) + (#{build-dispatch-call\ 3726}# + (lambda (#{pvars\ 3827}# + #{exp\ 3828}# + #{y\ 3829}# + #{r\ 3830}# + #{mod\ 3831}#) + (begin + (map cdr #{pvars\ 3827}#) + (let ((#{ids\ 3839}# (map car #{pvars\ 3827}#))) + (begin + (let ((#{labels\ 3843}# + (#{gen-labels\ 391}# #{ids\ 3839}#)) + (#{new-vars\ 3844}# + (map #{gen-var\ 484}# #{ids\ 3839}#))) + (#{build-application\ 302}# + #f + (#{build-primref\ 326}# #f 'apply) + (list (#{build-simple-lambda\ 320}# + #f + (map syntax->datum #{ids\ 3839}#) + #f + #{new-vars\ 3844}# + '() + (#{chi\ 456}# + #{exp\ 3828}# + (#{extend-env\ 364}# + #{labels\ 3843}# + (map (lambda (#{var\ 3848}# + #{level\ 3849}#) + (cons 'syntax + (cons #{var\ 3848}# + #{level\ 3849}#))) + #{new-vars\ 3844}# + (map cdr #{pvars\ 3827}#)) + #{r\ 3830}#) + (#{make-binding-wrap\ 420}# + #{ids\ 3839}# + #{labels\ 3843}# + '(())) + #{mod\ 3831}#)) + #{y\ 3829}#)))))))) + (#{gen-clause\ 3728}# + (lambda (#{x\ 3855}# + #{keys\ 3856}# + #{clauses\ 3857}# + #{r\ 3858}# + #{pat\ 3859}# + #{fender\ 3860}# + #{exp\ 3861}# + #{mod\ 3862}#) + (call-with-values + (lambda () + (#{convert-pattern\ 3724}# + #{pat\ 3859}# + #{keys\ 3856}#)) + (lambda (#{p\ 3871}# #{pvars\ 3872}#) + (if (not (#{distinct-bound-ids?\ 438}# + (map car #{pvars\ 3872}#))) + (syntax-violation + 'syntax-case + "duplicate pattern variable" + #{pat\ 3859}#) + (if (not (and-map + (lambda (#{x\ 3879}#) + (not (#{ellipsis?\ 472}# + (car #{x\ 3879}#)))) + #{pvars\ 3872}#)) + (syntax-violation + 'syntax-case + "misplaced ellipsis" + #{pat\ 3859}#) + (begin + (let ((#{y\ 3883}# (#{gen-var\ 484}# 'tmp))) + (#{build-application\ 302}# + #f + (#{build-simple-lambda\ 320}# + #f + (list 'tmp) + #f + (list #{y\ 3883}#) + '() + (begin + (let ((#{y\ 3887}# + (#{build-lexical-reference\ 308}# + 'value + #f + 'tmp + #{y\ 3883}#))) + (#{build-conditional\ 304}# + #f + (let ((#{tmp\ 3890}# + #{fender\ 3860}#)) + (let ((#{tmp\ 3891}# + ($sc-dispatch + #{tmp\ 3890}# + '#(atom #t)))) + (if #{tmp\ 3891}# + (@apply + (lambda () #{y\ 3887}#) + #{tmp\ 3891}#) + (let ((#{_\ 3893}# + #{tmp\ 3890}#)) + (#{build-conditional\ 304}# + #f + #{y\ 3887}# + (#{build-dispatch-call\ 3726}# + #{pvars\ 3872}# + #{fender\ 3860}# + #{y\ 3887}# + #{r\ 3858}# + #{mod\ 3862}#) + (#{build-data\ 328}# + #f + #f)))))) + (#{build-dispatch-call\ 3726}# + #{pvars\ 3872}# + #{exp\ 3861}# + #{y\ 3887}# + #{r\ 3858}# + #{mod\ 3862}#) + (#{gen-syntax-case\ 3730}# + #{x\ 3855}# + #{keys\ 3856}# + #{clauses\ 3857}# + #{r\ 3858}# + #{mod\ 3862}#))))) + (list (if (eq? #{p\ 3871}# 'any) + (#{build-application\ 302}# + #f + (#{build-primref\ 326}# #f 'list) + (list #{x\ 3855}#)) + (#{build-application\ 302}# + #f + (#{build-primref\ 326}# + #f + '$sc-dispatch) + (list #{x\ 3855}# + (#{build-data\ 328}# + #f + #{p\ 3871}#)))))))))))))) + (#{gen-syntax-case\ 3730}# + (lambda (#{x\ 3901}# + #{keys\ 3902}# + #{clauses\ 3903}# + #{r\ 3904}# + #{mod\ 3905}#) + (if (null? #{clauses\ 3903}#) + (#{build-application\ 302}# + #f + (#{build-primref\ 326}# #f 'syntax-violation) + (list (#{build-data\ 328}# #f #f) + (#{build-data\ 328}# + #f + "source expression failed to match any pattern") + #{x\ 3901}#)) + (let ((#{tmp\ 3915}# (car #{clauses\ 3903}#))) + (let ((#{tmp\ 3916}# + ($sc-dispatch #{tmp\ 3915}# '(any any)))) + (if #{tmp\ 3916}# + (@apply + (lambda (#{pat\ 3919}# #{exp\ 3920}#) + (if (if (#{id?\ 376}# #{pat\ 3919}#) + (and-map + (lambda (#{x\ 3923}#) + (not (#{free-id=?\ 432}# + #{pat\ 3919}# + #{x\ 3923}#))) + (cons '#(syntax-object + ... + ((top) + #(ribcage + #(pat exp) + #((top) (top)) + #("i3917" "i3918")) + #(ribcage () () ()) + #(ribcage + #(x keys clauses r mod) + #((top) + (top) + (top) + (top) + (top)) + #("i3906" + "i3907" + "i3908" + "i3909" + "i3910")) + #(ribcage + (gen-syntax-case + gen-clause + build-dispatch-call + convert-pattern) + ((top) (top) (top) (top)) + ("i3729" + "i3727" + "i3725" + "i3723")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile)) + #{keys\ 3902}#)) + #f) + (if (#{free-id=?\ 432}# + '#(syntax-object + pad + ((top) + #(ribcage + #(pat exp) + #((top) (top)) + #("i3917" "i3918")) + #(ribcage () () ()) + #(ribcage + #(x keys clauses r mod) + #((top) (top) (top) (top) (top)) + #("i3906" + "i3907" + "i3908" + "i3909" + "i3910")) + #(ribcage + (gen-syntax-case + gen-clause + build-dispatch-call + convert-pattern) + ((top) (top) (top) (top)) + ("i3729" "i3727" "i3725" "i3723")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile)) + '#(syntax-object + _ + ((top) + #(ribcage + #(pat exp) + #((top) (top)) + #("i3917" "i3918")) + #(ribcage () () ()) + #(ribcage + #(x keys clauses r mod) + #((top) (top) (top) (top) (top)) + #("i3906" + "i3907" + "i3908" + "i3909" + "i3910")) + #(ribcage + (gen-syntax-case + gen-clause + build-dispatch-call + convert-pattern) + ((top) (top) (top) (top)) + ("i3729" "i3727" "i3725" "i3723")) + #(ribcage + (lambda-var-list + gen-var + strip + chi-lambda-case + lambda*-formals + chi-simple-lambda + lambda-formals + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-body + chi-macro + chi-application + chi-expr + chi + 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 + 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-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i485" + "i483" + "i481" + "i479" + "i477" + "i475" + "i473" + "i471" + "i469" + "i467" + "i465" + "i463" + "i461" + "i459" + "i457" + "i455" + "i453" + "i451" + "i449" + "i447" + "i445" + "i443" + "i441" + "i439" + "i437" + "i435" + "i433" + "i431" + "i429" + "i427" + "i425" + "i423" + "i421" + "i419" + "i417" + "i416" + "i415" + "i413" + "i412" + "i411" + "i410" + "i409" + "i407" + "i405" + "i403" + "i401" + "i399" + "i397" + "i395" + "i393" + "i390" + "i388" + "i387" + "i386" + "i385" + "i384" + "i383" + "i382" + "i381" + "i380" + "i378" + "i377" + "i375" + "i373" + "i371" + "i369" + "i367" + "i365" + "i363" + "i362" + "i361" + "i360" + "i359" + "i358" + "i356" + "i355" + "i353" + "i351" + "i349" + "i347" + "i345" + "i343" + "i341" + "i339" + "i337" + "i335" + "i333" + "i331" + "i329" + "i327" + "i325" + "i323" + "i321" + "i319" + "i317" + "i315" + "i313" + "i311" + "i309" + "i307" + "i305" + "i303" + "i301" + "i299" + "i297" + "i295" + "i293" + "i291" + "i290" + "i288" + "i286" + "i285" + "i284" + "i283" + "i282" + "i280" + "i278" + "i276" + "i273" + "i271" + "i269" + "i267" + "i265" + "i263" + "i261" + "i259" + "i257" + "i255" + "i253" + "i251" + "i249" + "i247" + "i245" + "i243" + "i241" + "i239")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors + and-map*) + ((top) (top) (top) (top)) + ("i41" "i40" "i39" "i37"))) + (hygiene guile))) + (#{chi\ 456}# + #{exp\ 3920}# + #{r\ 3904}# + '(()) + #{mod\ 3905}#) + (begin + (let ((#{labels\ 3928}# + (list (#{gen-label\ 389}#))) + (#{var\ 3929}# + (#{gen-var\ 484}# #{pat\ 3919}#))) + (#{build-application\ 302}# + #f + (#{build-simple-lambda\ 320}# + #f + (list (syntax->datum #{pat\ 3919}#)) + #f + (list #{var\ 3929}#) + '() + (#{chi\ 456}# + #{exp\ 3920}# + (#{extend-env\ 364}# + #{labels\ 3928}# + (list (cons 'syntax + (cons #{var\ 3929}# + 0))) + #{r\ 3904}#) + (#{make-binding-wrap\ 420}# + (list #{pat\ 3919}#) + #{labels\ 3928}# + '(())) + #{mod\ 3905}#)) + (list #{x\ 3901}#))))) + (#{gen-clause\ 3728}# + #{x\ 3901}# + #{keys\ 3902}# + (cdr #{clauses\ 3903}#) + #{r\ 3904}# + #{pat\ 3919}# + #t + #{exp\ 3920}# + #{mod\ 3905}#))) + #{tmp\ 3916}#) + (let ((#{tmp\ 3935}# + ($sc-dispatch + #{tmp\ 3915}# + '(any any any)))) + (if #{tmp\ 3935}# + (@apply + (lambda (#{pat\ 3939}# + #{fender\ 3940}# + #{exp\ 3941}#) + (#{gen-clause\ 3728}# + #{x\ 3901}# + #{keys\ 3902}# + (cdr #{clauses\ 3903}#) + #{r\ 3904}# + #{pat\ 3939}# + #{fender\ 3940}# + #{exp\ 3941}# + #{mod\ 3905}#)) + #{tmp\ 3935}#) + (let ((#{_\ 3943}# #{tmp\ 3915}#)) + (syntax-violation + 'syntax-case + "invalid clause" + (car #{clauses\ 3903}#)))))))))))) + (begin + (lambda (#{e\ 3944}# + #{r\ 3945}# + #{w\ 3946}# + #{s\ 3947}# + #{mod\ 3948}#) + (begin + (let ((#{e\ 3955}# + (#{source-wrap\ 444}# + #{e\ 3944}# + #{w\ 3946}# + #{s\ 3947}# + #{mod\ 3948}#))) + (let ((#{tmp\ 3956}# #{e\ 3955}#)) + (let ((#{tmp\ 3957}# + ($sc-dispatch + #{tmp\ 3956}# + '(_ any each-any . each-any)))) + (if #{tmp\ 3957}# + (@apply + (lambda (#{val\ 3961}# #{key\ 3962}# #{m\ 3963}#) + (if (and-map + (lambda (#{x\ 3964}#) + (if (#{id?\ 376}# #{x\ 3964}#) + (not (#{ellipsis?\ 472}# + #{x\ 3964}#)) + #f)) + #{key\ 3962}#) + (begin + (let ((#{x\ 3970}# + (#{gen-var\ 484}# 'tmp))) + (#{build-application\ 302}# + #{s\ 3947}# + (#{build-simple-lambda\ 320}# + #f + (list 'tmp) + #f + (list #{x\ 3970}#) + '() + (#{gen-syntax-case\ 3730}# + (#{build-lexical-reference\ 308}# + 'value + #f + 'tmp + #{x\ 3970}#) + #{key\ 3962}# + #{m\ 3963}# + #{r\ 3945}# + #{mod\ 3948}#)) + (list (#{chi\ 456}# + #{val\ 3961}# + #{r\ 3945}# + '(()) + #{mod\ 3948}#))))) + (syntax-violation + 'syntax-case + "invalid literals list" + #{e\ 3955}#))) + #{tmp\ 3957}#) + (syntax-violation + #f + "source expression failed to match any pattern" + #{tmp\ 3956}#)))))))))) + (set! macroexpand + (lambda* + (#{x\ 3976}# + #:optional + (#{m\ 3978}# 'e) + (#{esew\ 3980}# '(eval))) + (#{chi-top-sequence\ 448}# + (list #{x\ 3976}#) + '() + '((top)) + #f + #{m\ 3978}# + #{esew\ 3980}# + (cons 'hygiene (module-name (current-module)))))) + (set! identifier? + (lambda (#{x\ 3984}#) + (#{nonsymbol-id?\ 374}# #{x\ 3984}#))) + (set! datum->syntax + (lambda (#{id\ 3986}# #{datum\ 3987}#) + (#{make-syntax-object\ 340}# + #{datum\ 3987}# + (#{syntax-object-wrap\ 346}# #{id\ 3986}#) + (#{syntax-object-module\ 348}# #{id\ 3986}#)))) + (set! syntax->datum + (lambda (#{x\ 3990}#) + (#{strip\ 482}# #{x\ 3990}# '(())))) + (set! syntax-source + (lambda (#{x\ 3993}#) + (#{source-annotation\ 357}# #{x\ 3993}#))) + (set! generate-temporaries + (lambda (#{ls\ 3995}#) + (begin + (begin + (let ((#{x\ 3999}# #{ls\ 3995}#)) + (if (not (list? #{x\ 3999}#)) + (syntax-violation + 'generate-temporaries + "invalid argument" + #{x\ 3999}#)))) + (map (lambda (#{x\ 4000}#) + (#{wrap\ 442}# (gensym) '((top)) #f)) + #{ls\ 3995}#)))) + (set! free-identifier=? + (lambda (#{x\ 4004}# #{y\ 4005}#) + (begin + (begin + (let ((#{x\ 4010}# #{x\ 4004}#)) + (if (not (#{nonsymbol-id?\ 374}# #{x\ 4010}#)) + (syntax-violation + 'free-identifier=? + "invalid argument" + #{x\ 4010}#)))) + (begin + (let ((#{x\ 4013}# #{y\ 4005}#)) + (if (not (#{nonsymbol-id?\ 374}# #{x\ 4013}#)) + (syntax-violation + 'free-identifier=? + "invalid argument" + #{x\ 4013}#)))) + (#{free-id=?\ 432}# #{x\ 4004}# #{y\ 4005}#)))) + (set! bound-identifier=? + (lambda (#{x\ 4014}# #{y\ 4015}#) + (begin + (begin + (let ((#{x\ 4020}# #{x\ 4014}#)) + (if (not (#{nonsymbol-id?\ 374}# #{x\ 4020}#)) + (syntax-violation + 'bound-identifier=? + "invalid argument" + #{x\ 4020}#)))) + (begin + (let ((#{x\ 4023}# #{y\ 4015}#)) + (if (not (#{nonsymbol-id?\ 374}# #{x\ 4023}#)) + (syntax-violation + 'bound-identifier=? + "invalid argument" + #{x\ 4023}#)))) + (#{bound-id=?\ 434}# #{x\ 4014}# #{y\ 4015}#)))) + (set! syntax-violation + (lambda* + (#{who\ 4024}# + #{message\ 4025}# + #{form\ 4026}# + #:optional + (#{subform\ 4030}# #f)) + (begin + (begin + (let ((#{x\ 4034}# #{who\ 4024}#)) + (if (not (let ((#{x\ 4035}# #{x\ 4034}#)) + (begin + (let ((#{t\ 4039}# (not #{x\ 4035}#))) + (if #{t\ 4039}# + #{t\ 4039}# + (begin + (let ((#{t\ 4042}# + (string? #{x\ 4035}#))) + (if #{t\ 4042}# + #{t\ 4042}# + (symbol? #{x\ 4035}#))))))))) + (syntax-violation + 'syntax-violation + "invalid argument" + #{x\ 4034}#)))) + (begin + (let ((#{x\ 4046}# #{message\ 4025}#)) + (if (not (string? #{x\ 4046}#)) + (syntax-violation + 'syntax-violation + "invalid argument" + #{x\ 4046}#)))) + (throw 'syntax-error + #{who\ 4024}# + #{message\ 4025}# + (#{source-annotation\ 357}# + (begin + (let ((#{t\ 4049}# #{form\ 4026}#)) + (if #{t\ 4049}# #{t\ 4049}# #{subform\ 4030}#)))) + (#{strip\ 482}# #{form\ 4026}# '(())) + (if #{subform\ 4030}# + (#{strip\ 482}# #{subform\ 4030}# '(())) + #f))))) + (letrec* + ((#{match-each\ 4056}# + (lambda (#{e\ 4069}# + #{p\ 4070}# + #{w\ 4071}# + #{mod\ 4072}#) + (if (pair? #{e\ 4069}#) + (begin + (let ((#{first\ 4080}# + (#{match\ 4068}# + (car #{e\ 4069}#) + #{p\ 4070}# + #{w\ 4071}# + '() + #{mod\ 4072}#))) + (if #{first\ 4080}# + (begin + (let ((#{rest\ 4084}# + (#{match-each\ 4056}# + (cdr #{e\ 4069}#) + #{p\ 4070}# + #{w\ 4071}# + #{mod\ 4072}#))) + (if #{rest\ 4084}# + (cons #{first\ 4080}# #{rest\ 4084}#) + #f))) + #f))) + (if (null? #{e\ 4069}#) + '() + (if (#{syntax-object?\ 342}# #{e\ 4069}#) + (#{match-each\ 4056}# + (#{syntax-object-expression\ 344}# #{e\ 4069}#) + #{p\ 4070}# + (#{join-wraps\ 424}# + #{w\ 4071}# + (#{syntax-object-wrap\ 346}# #{e\ 4069}#)) + (#{syntax-object-module\ 348}# #{e\ 4069}#)) + #f))))) + (#{match-each+\ 4058}# + (lambda (#{e\ 4092}# + #{x-pat\ 4093}# + #{y-pat\ 4094}# + #{z-pat\ 4095}# + #{w\ 4096}# + #{r\ 4097}# + #{mod\ 4098}#) + (letrec* + ((#{f\ 4109}# + (lambda (#{e\ 4110}# #{w\ 4111}#) + (if (pair? #{e\ 4110}#) + (call-with-values + (lambda () + (#{f\ 4109}# (cdr #{e\ 4110}#) #{w\ 4111}#)) + (lambda (#{xr*\ 4114}# #{y-pat\ 4115}# #{r\ 4116}#) + (if #{r\ 4116}# + (if (null? #{y-pat\ 4115}#) + (begin + (let ((#{xr\ 4121}# + (#{match\ 4068}# + (car #{e\ 4110}#) + #{x-pat\ 4093}# + #{w\ 4111}# + '() + #{mod\ 4098}#))) + (if #{xr\ 4121}# + (values + (cons #{xr\ 4121}# #{xr*\ 4114}#) + #{y-pat\ 4115}# + #{r\ 4116}#) + (values #f #f #f)))) + (values + '() + (cdr #{y-pat\ 4115}#) + (#{match\ 4068}# + (car #{e\ 4110}#) + (car #{y-pat\ 4115}#) + #{w\ 4111}# + #{r\ 4116}# + #{mod\ 4098}#))) + (values #f #f #f)))) + (if (#{syntax-object?\ 342}# #{e\ 4110}#) + (#{f\ 4109}# + (#{syntax-object-expression\ 344}# #{e\ 4110}#) + (#{join-wraps\ 424}# #{w\ 4111}# #{e\ 4110}#)) + (values + '() + #{y-pat\ 4094}# + (#{match\ 4068}# + #{e\ 4110}# + #{z-pat\ 4095}# + #{w\ 4111}# + #{r\ 4097}# + #{mod\ 4098}#))))))) + (begin (#{f\ 4109}# #{e\ 4092}# #{w\ 4096}#))))) + (#{match-each-any\ 4060}# + (lambda (#{e\ 4125}# #{w\ 4126}# #{mod\ 4127}#) + (if (pair? #{e\ 4125}#) + (begin + (let ((#{l\ 4134}# + (#{match-each-any\ 4060}# + (cdr #{e\ 4125}#) + #{w\ 4126}# + #{mod\ 4127}#))) + (if #{l\ 4134}# + (cons (#{wrap\ 442}# + (car #{e\ 4125}#) + #{w\ 4126}# + #{mod\ 4127}#) + #{l\ 4134}#) + #f))) + (if (null? #{e\ 4125}#) + '() + (if (#{syntax-object?\ 342}# #{e\ 4125}#) + (#{match-each-any\ 4060}# + (#{syntax-object-expression\ 344}# #{e\ 4125}#) + (#{join-wraps\ 424}# + #{w\ 4126}# + (#{syntax-object-wrap\ 346}# #{e\ 4125}#)) + #{mod\ 4127}#) + #f))))) + (#{match-empty\ 4062}# + (lambda (#{p\ 4142}# #{r\ 4143}#) + (if (null? #{p\ 4142}#) + #{r\ 4143}# + (if (eq? #{p\ 4142}# '_) + #{r\ 4143}# + (if (eq? #{p\ 4142}# 'any) + (cons '() #{r\ 4143}#) + (if (pair? #{p\ 4142}#) + (#{match-empty\ 4062}# + (car #{p\ 4142}#) + (#{match-empty\ 4062}# + (cdr #{p\ 4142}#) + #{r\ 4143}#)) + (if (eq? #{p\ 4142}# 'each-any) + (cons '() #{r\ 4143}#) + (begin + (let ((#{atom-key\ 4159}# + (vector-ref #{p\ 4142}# 0))) + (if (eqv? #{atom-key\ 4159}# 'each) + (#{match-empty\ 4062}# + (vector-ref #{p\ 4142}# 1) + #{r\ 4143}#) + (if (eqv? #{atom-key\ 4159}# 'each+) + (#{match-empty\ 4062}# + (vector-ref #{p\ 4142}# 1) + (#{match-empty\ 4062}# + (reverse (vector-ref #{p\ 4142}# 2)) + (#{match-empty\ 4062}# + (vector-ref #{p\ 4142}# 3) + #{r\ 4143}#))) + (if (if (eqv? #{atom-key\ 4159}# 'free-id) + #t + (eqv? #{atom-key\ 4159}# 'atom)) + #{r\ 4143}# + (if (eqv? #{atom-key\ 4159}# 'vector) + (#{match-empty\ 4062}# + (vector-ref #{p\ 4142}# 1) + #{r\ 4143}#)))))))))))))) + (#{combine\ 4064}# + (lambda (#{r*\ 4164}# #{r\ 4165}#) + (if (null? (car #{r*\ 4164}#)) + #{r\ 4165}# + (cons (map car #{r*\ 4164}#) + (#{combine\ 4064}# + (map cdr #{r*\ 4164}#) + #{r\ 4165}#))))) + (#{match*\ 4066}# + (lambda (#{e\ 4168}# + #{p\ 4169}# + #{w\ 4170}# + #{r\ 4171}# + #{mod\ 4172}#) + (if (null? #{p\ 4169}#) + (if (null? #{e\ 4168}#) #{r\ 4171}# #f) + (if (pair? #{p\ 4169}#) + (if (pair? #{e\ 4168}#) + (#{match\ 4068}# + (car #{e\ 4168}#) + (car #{p\ 4169}#) + #{w\ 4170}# + (#{match\ 4068}# + (cdr #{e\ 4168}#) + (cdr #{p\ 4169}#) + #{w\ 4170}# + #{r\ 4171}# + #{mod\ 4172}#) + #{mod\ 4172}#) + #f) + (if (eq? #{p\ 4169}# 'each-any) + (begin + (let ((#{l\ 4189}# + (#{match-each-any\ 4060}# + #{e\ 4168}# + #{w\ 4170}# + #{mod\ 4172}#))) + (if #{l\ 4189}# + (cons #{l\ 4189}# #{r\ 4171}#) + #f))) + (begin + (let ((#{atom-key\ 4195}# (vector-ref #{p\ 4169}# 0))) + (if (eqv? #{atom-key\ 4195}# 'each) + (if (null? #{e\ 4168}#) + (#{match-empty\ 4062}# + (vector-ref #{p\ 4169}# 1) + #{r\ 4171}#) + (begin + (let ((#{l\ 4198}# + (#{match-each\ 4056}# + #{e\ 4168}# + (vector-ref #{p\ 4169}# 1) + #{w\ 4170}# + #{mod\ 4172}#))) + (if #{l\ 4198}# + (letrec* + ((#{collect\ 4203}# + (lambda (#{l\ 4204}#) + (if (null? (car #{l\ 4204}#)) + #{r\ 4171}# + (cons (map car #{l\ 4204}#) + (#{collect\ 4203}# + (map cdr + #{l\ 4204}#))))))) + (begin (#{collect\ 4203}# #{l\ 4198}#))) + #f)))) + (if (eqv? #{atom-key\ 4195}# 'each+) + (call-with-values + (lambda () + (#{match-each+\ 4058}# + #{e\ 4168}# + (vector-ref #{p\ 4169}# 1) + (vector-ref #{p\ 4169}# 2) + (vector-ref #{p\ 4169}# 3) + #{w\ 4170}# + #{r\ 4171}# + #{mod\ 4172}#)) + (lambda (#{xr*\ 4206}# + #{y-pat\ 4207}# + #{r\ 4208}#) + (if #{r\ 4208}# + (if (null? #{y-pat\ 4207}#) + (if (null? #{xr*\ 4206}#) + (#{match-empty\ 4062}# + (vector-ref #{p\ 4169}# 1) + #{r\ 4208}#) + (#{combine\ 4064}# + #{xr*\ 4206}# + #{r\ 4208}#)) + #f) + #f))) + (if (eqv? #{atom-key\ 4195}# 'free-id) + (if (#{id?\ 376}# #{e\ 4168}#) + (if (#{free-id=?\ 432}# + (#{wrap\ 442}# + #{e\ 4168}# + #{w\ 4170}# + #{mod\ 4172}#) + (vector-ref #{p\ 4169}# 1)) + #{r\ 4171}# + #f) + #f) + (if (eqv? #{atom-key\ 4195}# 'atom) + (if (equal? + (vector-ref #{p\ 4169}# 1) + (#{strip\ 482}# + #{e\ 4168}# + #{w\ 4170}#)) + #{r\ 4171}# + #f) + (if (eqv? #{atom-key\ 4195}# 'vector) + (if (vector? #{e\ 4168}#) + (#{match\ 4068}# + (vector->list #{e\ 4168}#) + (vector-ref #{p\ 4169}# 1) + #{w\ 4170}# + #{r\ 4171}# + #{mod\ 4172}#) + #f))))))))))))) + (#{match\ 4068}# + (lambda (#{e\ 4225}# + #{p\ 4226}# + #{w\ 4227}# + #{r\ 4228}# + #{mod\ 4229}#) + (if (not #{r\ 4228}#) + #f + (if (eq? #{p\ 4226}# '_) + #{r\ 4228}# + (if (eq? #{p\ 4226}# 'any) + (cons (#{wrap\ 442}# + #{e\ 4225}# + #{w\ 4227}# + #{mod\ 4229}#) + #{r\ 4228}#) + (if (#{syntax-object?\ 342}# #{e\ 4225}#) + (#{match*\ 4066}# + (#{syntax-object-expression\ 344}# #{e\ 4225}#) + #{p\ 4226}# + (#{join-wraps\ 424}# + #{w\ 4227}# + (#{syntax-object-wrap\ 346}# #{e\ 4225}#)) + #{r\ 4228}# + (#{syntax-object-module\ 348}# #{e\ 4225}#)) + (#{match*\ 4066}# + #{e\ 4225}# + #{p\ 4226}# + #{w\ 4227}# + #{r\ 4228}# + #{mod\ 4229}#)))))))) + (begin + (set! $sc-dispatch + (lambda (#{e\ 4244}# #{p\ 4245}#) + (if (eq? #{p\ 4245}# 'any) + (list #{e\ 4244}#) + (if (eq? #{p\ 4245}# '_) + '() + (if (#{syntax-object?\ 342}# #{e\ 4244}#) + (#{match*\ 4066}# + (#{syntax-object-expression\ 344}# #{e\ 4244}#) + #{p\ 4245}# + (#{syntax-object-wrap\ 346}# #{e\ 4244}#) + '() + (#{syntax-object-module\ 348}# #{e\ 4244}#)) + (#{match*\ 4066}# + #{e\ 4244}# + #{p\ 4245}# + '(()) + '() + #f))))))))))))) (define with-syntax (make-syntax-transformer 'with-syntax 'macro - (lambda (#{x\ 4197}#) - (let ((#{tmp\ 4199}# #{x\ 4197}#)) - (let ((#{tmp\ 4200}# + (lambda (#{x\ 4256}#) + (let ((#{tmp\ 4258}# #{x\ 4256}#)) + (let ((#{tmp\ 4259}# ($sc-dispatch - #{tmp\ 4199}# + #{tmp\ 4258}# '(_ () any . each-any)))) - (if #{tmp\ 4200}# + (if #{tmp\ 4259}# (@apply - (lambda (#{e1\ 4203}# #{e2\ 4204}#) + (lambda (#{e1\ 4262}# #{e2\ 4263}#) (cons '#(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4201" "i4202")) + #("i4260" "i4261")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4198"))) + #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) - (cons '() (cons #{e1\ 4203}# #{e2\ 4204}#)))) - #{tmp\ 4200}#) - (let ((#{tmp\ 4206}# + (cons '() (cons #{e1\ 4262}# #{e2\ 4263}#)))) + #{tmp\ 4259}#) + (let ((#{tmp\ 4265}# ($sc-dispatch - #{tmp\ 4199}# + #{tmp\ 4258}# '(_ ((any any)) any . each-any)))) - (if #{tmp\ 4206}# + (if #{tmp\ 4265}# (@apply - (lambda (#{out\ 4211}# - #{in\ 4212}# - #{e1\ 4213}# - #{e2\ 4214}#) + (lambda (#{out\ 4270}# + #{in\ 4271}# + #{e1\ 4272}# + #{e2\ 4273}#) (list '#(syntax-object syntax-case ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4207" "i4208" "i4209" "i4210")) + #("i4266" "i4267" "i4268" "i4269")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4198"))) + #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) - #{in\ 4212}# + #{in\ 4271}# '() - (list #{out\ 4211}# + (list #{out\ 4270}# (cons '#(syntax-object let ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4207" "i4208" "i4209" "i4210")) + #("i4266" "i4267" "i4268" "i4269")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4198"))) + #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) (cons '() - (cons #{e1\ 4213}# - #{e2\ 4214}#)))))) - #{tmp\ 4206}#) - (let ((#{tmp\ 4216}# + (cons #{e1\ 4272}# + #{e2\ 4273}#)))))) + #{tmp\ 4265}#) + (let ((#{tmp\ 4275}# ($sc-dispatch - #{tmp\ 4199}# + #{tmp\ 4258}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 4216}# + (if #{tmp\ 4275}# (@apply - (lambda (#{out\ 4221}# - #{in\ 4222}# - #{e1\ 4223}# - #{e2\ 4224}#) + (lambda (#{out\ 4280}# + #{in\ 4281}# + #{e1\ 4282}# + #{e2\ 4283}#) (list '#(syntax-object syntax-case ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4217" "i4218" "i4219" "i4220")) + #("i4276" "i4277" "i4278" "i4279")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4198"))) + #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) (cons '#(syntax-object list @@ -14582,63 +14483,63 @@ #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4217" "i4218" "i4219" "i4220")) + #("i4276" "i4277" "i4278" "i4279")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4198"))) + #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) - #{in\ 4222}#) + #{in\ 4281}#) '() - (list #{out\ 4221}# + (list #{out\ 4280}# (cons '#(syntax-object let ((top) #(ribcage #(out in e1 e2) #((top) (top) (top) (top)) - #("i4217" - "i4218" - "i4219" - "i4220")) + #("i4276" + "i4277" + "i4278" + "i4279")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4198"))) + #("i4257"))) (hygiene guile)) (cons '() - (cons #{e1\ 4223}# - #{e2\ 4224}#)))))) - #{tmp\ 4216}#) + (cons #{e1\ 4282}# + #{e2\ 4283}#)))))) + #{tmp\ 4275}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4199}#))))))))))) + #{tmp\ 4258}#))))))))))) (define syntax-rules (make-syntax-transformer 'syntax-rules 'macro - (lambda (#{x\ 4228}#) - (let ((#{tmp\ 4230}# #{x\ 4228}#)) - (let ((#{tmp\ 4231}# + (lambda (#{x\ 4287}#) + (let ((#{tmp\ 4289}# #{x\ 4287}#)) + (let ((#{tmp\ 4290}# ($sc-dispatch - #{tmp\ 4230}# + #{tmp\ 4289}# '(_ each-any . #(each ((any . any) any)))))) - (if #{tmp\ 4231}# + (if #{tmp\ 4290}# (@apply - (lambda (#{k\ 4236}# - #{keyword\ 4237}# - #{pattern\ 4238}# - #{template\ 4239}#) + (lambda (#{k\ 4295}# + #{keyword\ 4296}# + #{pattern\ 4297}# + #{template\ 4298}#) (list '#(syntax-object lambda ((top) #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) '(#(syntax-object x @@ -14646,9 +14547,9 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile))) (vector '(#(syntax-object @@ -14657,9 +14558,9 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) . #(syntax-object @@ -14668,9 +14569,9 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile))) (cons '#(syntax-object patterns @@ -14678,20 +14579,20 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - #{pattern\ 4238}#)) + #{pattern\ 4297}#)) (cons '#(syntax-object syntax-case ((top) #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) (cons '#(syntax-object x @@ -14699,13 +14600,13 @@ #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("i4232" "i4233" "i4234" "i4235")) + #("i4291" "i4292" "i4293" "i4294")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - (cons #{k\ 4236}# - (map (lambda (#{tmp\ 4243}# - #{tmp\ 4242}#) + (cons #{k\ 4295}# + (map (lambda (#{tmp\ 4302}# + #{tmp\ 4301}#) (list (cons '#(syntax-object dummy ((top) @@ -14718,10 +14619,10 @@ (top) (top) (top)) - #("i4232" - "i4233" - "i4234" - "i4235")) + #("i4291" + "i4292" + "i4293" + "i4294")) #(ribcage () () @@ -14729,9 +14630,9 @@ #(ribcage #(x) #((top)) - #("i4229"))) + #("i4288"))) (hygiene guile)) - #{tmp\ 4242}#) + #{tmp\ 4301}#) (list '#(syntax-object syntax ((top) @@ -14744,10 +14645,10 @@ (top) (top) (top)) - #("i4232" - "i4233" - "i4234" - "i4235")) + #("i4291" + "i4292" + "i4293" + "i4294")) #(ribcage () () @@ -14755,41 +14656,41 @@ #(ribcage #(x) #((top)) - #("i4229"))) + #("i4288"))) (hygiene guile)) - #{tmp\ 4243}#))) - #{template\ 4239}# - #{pattern\ 4238}#)))))) - #{tmp\ 4231}#) - (let ((#{tmp\ 4244}# + #{tmp\ 4302}#))) + #{template\ 4298}# + #{pattern\ 4297}#)))))) + #{tmp\ 4290}#) + (let ((#{tmp\ 4303}# ($sc-dispatch - #{tmp\ 4230}# + #{tmp\ 4289}# '(_ each-any any . #(each ((any . any) any)))))) - (if (if #{tmp\ 4244}# + (if (if #{tmp\ 4303}# (@apply - (lambda (#{k\ 4250}# - #{docstring\ 4251}# - #{keyword\ 4252}# - #{pattern\ 4253}# - #{template\ 4254}#) - (string? (syntax->datum #{docstring\ 4251}#))) - #{tmp\ 4244}#) + (lambda (#{k\ 4309}# + #{docstring\ 4310}# + #{keyword\ 4311}# + #{pattern\ 4312}# + #{template\ 4313}#) + (string? (syntax->datum #{docstring\ 4310}#))) + #{tmp\ 4303}#) #f) (@apply - (lambda (#{k\ 4260}# - #{docstring\ 4261}# - #{keyword\ 4262}# - #{pattern\ 4263}# - #{template\ 4264}#) + (lambda (#{k\ 4319}# + #{docstring\ 4320}# + #{keyword\ 4321}# + #{pattern\ 4322}# + #{template\ 4323}#) (list '#(syntax-object lambda ((top) #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4255" "i4256" "i4257" "i4258" "i4259")) + #("i4314" "i4315" "i4316" "i4317" "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) '(#(syntax-object x @@ -14797,11 +14698,11 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4255" "i4256" "i4257" "i4258" "i4259")) + #("i4314" "i4315" "i4316" "i4317" "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile))) - #{docstring\ 4261}# + #{docstring\ 4320}# (vector '(#(syntax-object macro-type @@ -14809,9 +14710,9 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4255" "i4256" "i4257" "i4258" "i4259")) + #("i4314" "i4315" "i4316" "i4317" "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) . #(syntax-object @@ -14820,9 +14721,9 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4255" "i4256" "i4257" "i4258" "i4259")) + #("i4314" "i4315" "i4316" "i4317" "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile))) (cons '#(syntax-object patterns @@ -14830,28 +14731,28 @@ #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4255" - "i4256" - "i4257" - "i4258" - "i4259")) + #("i4314" + "i4315" + "i4316" + "i4317" + "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - #{pattern\ 4263}#)) + #{pattern\ 4322}#)) (cons '#(syntax-object syntax-case ((top) #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("i4255" - "i4256" - "i4257" - "i4258" - "i4259")) + #("i4314" + "i4315" + "i4316" + "i4317" + "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) (cons '#(syntax-object x @@ -14863,17 +14764,17 @@ pattern template) #((top) (top) (top) (top) (top)) - #("i4255" - "i4256" - "i4257" - "i4258" - "i4259")) + #("i4314" + "i4315" + "i4316" + "i4317" + "i4318")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4229"))) + #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - (cons #{k\ 4260}# - (map (lambda (#{tmp\ 4268}# - #{tmp\ 4267}#) + (cons #{k\ 4319}# + (map (lambda (#{tmp\ 4327}# + #{tmp\ 4326}#) (list (cons '#(syntax-object dummy ((top) @@ -14888,11 +14789,11 @@ (top) (top) (top)) - #("i4255" - "i4256" - "i4257" - "i4258" - "i4259")) + #("i4314" + "i4315" + "i4316" + "i4317" + "i4318")) #(ribcage () () @@ -14900,10 +14801,10 @@ #(ribcage #(x) #((top)) - #("i4229"))) + #("i4288"))) (hygiene guile)) - #{tmp\ 4267}#) + #{tmp\ 4326}#) (list '#(syntax-object syntax ((top) @@ -14918,11 +14819,11 @@ (top) (top) (top)) - #("i4255" - "i4256" - "i4257" - "i4258" - "i4259")) + #("i4314" + "i4315" + "i4316" + "i4317" + "i4318")) #(ribcage () () @@ -14930,48 +14831,48 @@ #(ribcage #(x) #((top)) - #("i4229"))) + #("i4288"))) (hygiene guile)) - #{tmp\ 4268}#))) - #{template\ 4264}# - #{pattern\ 4263}#)))))) - #{tmp\ 4244}#) + #{tmp\ 4327}#))) + #{template\ 4323}# + #{pattern\ 4322}#)))))) + #{tmp\ 4303}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4230}#))))))))) + #{tmp\ 4289}#))))))))) (define let* (make-syntax-transformer 'let* 'macro - (lambda (#{x\ 4269}#) - (let ((#{tmp\ 4271}# #{x\ 4269}#)) - (let ((#{tmp\ 4272}# + (lambda (#{x\ 4328}#) + (let ((#{tmp\ 4330}# #{x\ 4328}#)) + (let ((#{tmp\ 4331}# ($sc-dispatch - #{tmp\ 4271}# + #{tmp\ 4330}# '(any #(each (any any)) any . each-any)))) - (if (if #{tmp\ 4272}# + (if (if #{tmp\ 4331}# (@apply - (lambda (#{let*\ 4278}# - #{x\ 4279}# - #{v\ 4280}# - #{e1\ 4281}# - #{e2\ 4282}#) - (and-map identifier? #{x\ 4279}#)) - #{tmp\ 4272}#) + (lambda (#{let*\ 4337}# + #{x\ 4338}# + #{v\ 4339}# + #{e1\ 4340}# + #{e2\ 4341}#) + (and-map identifier? #{x\ 4338}#)) + #{tmp\ 4331}#) #f) (@apply - (lambda (#{let*\ 4289}# - #{x\ 4290}# - #{v\ 4291}# - #{e1\ 4292}# - #{e2\ 4293}#) + (lambda (#{let*\ 4348}# + #{x\ 4349}# + #{v\ 4350}# + #{e1\ 4351}# + #{e2\ 4352}#) (letrec* - ((#{f\ 4296}# - (lambda (#{bindings\ 4297}#) - (if (null? #{bindings\ 4297}#) + ((#{f\ 4355}# + (lambda (#{bindings\ 4356}#) + (if (null? #{bindings\ 4356}#) (cons '#(syntax-object let ((top) @@ -14979,27 +14880,27 @@ #(ribcage #(f bindings) #((top) (top)) - #("i4294" "i4295")) + #("i4353" "i4354")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) - #("i4284" - "i4285" - "i4286" - "i4287" - "i4288")) + #("i4343" + "i4344" + "i4345" + "i4346" + "i4347")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4270"))) + #(ribcage #(x) #((top)) #("i4329"))) (hygiene guile)) - (cons '() (cons #{e1\ 4292}# #{e2\ 4293}#))) - (let ((#{tmp\ 4302}# - (list (#{f\ 4296}# (cdr #{bindings\ 4297}#)) - (car #{bindings\ 4297}#)))) - (let ((#{tmp\ 4303}# - ($sc-dispatch #{tmp\ 4302}# '(any any)))) - (if #{tmp\ 4303}# + (cons '() (cons #{e1\ 4351}# #{e2\ 4352}#))) + (let ((#{tmp\ 4361}# + (list (#{f\ 4355}# (cdr #{bindings\ 4356}#)) + (car #{bindings\ 4356}#)))) + (let ((#{tmp\ 4362}# + ($sc-dispatch #{tmp\ 4361}# '(any any)))) + (if #{tmp\ 4362}# (@apply - (lambda (#{body\ 4306}# #{binding\ 4307}#) + (lambda (#{body\ 4365}# #{binding\ 4366}#) (list '#(syntax-object let ((top) @@ -15007,96 +14908,96 @@ #(ribcage #(body binding) #((top) (top)) - #("i4304" "i4305")) + #("i4363" "i4364")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) - #("i4294" "i4295")) + #("i4353" "i4354")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) - #("i4284" - "i4285" - "i4286" - "i4287" - "i4288")) + #("i4343" + "i4344" + "i4345" + "i4346" + "i4347")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4270"))) + #("i4329"))) (hygiene guile)) - (list #{binding\ 4307}#) - #{body\ 4306}#)) - #{tmp\ 4303}#) + (list #{binding\ 4366}#) + #{body\ 4365}#)) + #{tmp\ 4362}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4302}#)))))))) + #{tmp\ 4361}#)))))))) (begin - (#{f\ 4296}# (map list #{x\ 4290}# #{v\ 4291}#))))) - #{tmp\ 4272}#) + (#{f\ 4355}# (map list #{x\ 4349}# #{v\ 4350}#))))) + #{tmp\ 4331}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4271}#))))))) + #{tmp\ 4330}#))))))) (define do (make-syntax-transformer 'do 'macro - (lambda (#{orig-x\ 4308}#) - (let ((#{tmp\ 4310}# #{orig-x\ 4308}#)) - (let ((#{tmp\ 4311}# + (lambda (#{orig-x\ 4367}#) + (let ((#{tmp\ 4369}# #{orig-x\ 4367}#)) + (let ((#{tmp\ 4370}# ($sc-dispatch - #{tmp\ 4310}# + #{tmp\ 4369}# '(_ #(each (any any . any)) (any . each-any) . each-any)))) - (if #{tmp\ 4311}# + (if #{tmp\ 4370}# (@apply - (lambda (#{var\ 4318}# - #{init\ 4319}# - #{step\ 4320}# - #{e0\ 4321}# - #{e1\ 4322}# - #{c\ 4323}#) - (let ((#{tmp\ 4325}# - (map (lambda (#{v\ 4346}# #{s\ 4347}#) - (let ((#{tmp\ 4350}# #{s\ 4347}#)) - (let ((#{tmp\ 4351}# - ($sc-dispatch #{tmp\ 4350}# '()))) - (if #{tmp\ 4351}# + (lambda (#{var\ 4377}# + #{init\ 4378}# + #{step\ 4379}# + #{e0\ 4380}# + #{e1\ 4381}# + #{c\ 4382}#) + (let ((#{tmp\ 4384}# + (map (lambda (#{v\ 4405}# #{s\ 4406}#) + (let ((#{tmp\ 4409}# #{s\ 4406}#)) + (let ((#{tmp\ 4410}# + ($sc-dispatch #{tmp\ 4409}# '()))) + (if #{tmp\ 4410}# (@apply - (lambda () #{v\ 4346}#) - #{tmp\ 4351}#) - (let ((#{tmp\ 4352}# + (lambda () #{v\ 4405}#) + #{tmp\ 4410}#) + (let ((#{tmp\ 4411}# ($sc-dispatch - #{tmp\ 4350}# + #{tmp\ 4409}# '(any)))) - (if #{tmp\ 4352}# + (if #{tmp\ 4411}# (@apply - (lambda (#{e\ 4354}#) #{e\ 4354}#) - #{tmp\ 4352}#) - (let ((#{_\ 4356}# #{tmp\ 4350}#)) + (lambda (#{e\ 4413}#) #{e\ 4413}#) + #{tmp\ 4411}#) + (let ((#{_\ 4415}# #{tmp\ 4409}#)) (syntax-violation 'do "bad step expression" - #{orig-x\ 4308}# - #{s\ 4347}#)))))))) - #{var\ 4318}# - #{step\ 4320}#))) - (let ((#{tmp\ 4326}# - ($sc-dispatch #{tmp\ 4325}# 'each-any))) - (if #{tmp\ 4326}# + #{orig-x\ 4367}# + #{s\ 4406}#)))))))) + #{var\ 4377}# + #{step\ 4379}#))) + (let ((#{tmp\ 4385}# + ($sc-dispatch #{tmp\ 4384}# 'each-any))) + (if #{tmp\ 4385}# (@apply - (lambda (#{step\ 4328}#) - (let ((#{tmp\ 4329}# #{e1\ 4322}#)) - (let ((#{tmp\ 4330}# - ($sc-dispatch #{tmp\ 4329}# '()))) - (if #{tmp\ 4330}# + (lambda (#{step\ 4387}#) + (let ((#{tmp\ 4388}# #{e1\ 4381}#)) + (let ((#{tmp\ 4389}# + ($sc-dispatch #{tmp\ 4388}# '()))) + (if #{tmp\ 4389}# (@apply (lambda () (list '#(syntax-object @@ -15106,7 +15007,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15115,17 +15016,17 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) '#(syntax-object doloop @@ -15134,7 +15035,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15143,21 +15044,21 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) (map list - #{var\ 4318}# - #{init\ 4319}#) + #{var\ 4377}# + #{init\ 4378}#) (list '#(syntax-object if ((top) @@ -15165,7 +15066,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15174,17 +15075,17 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) (list '#(syntax-object not @@ -15193,7 +15094,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15207,19 +15108,19 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) - #{e0\ 4321}#) + #{e0\ 4380}#) (cons '#(syntax-object begin ((top) @@ -15227,7 +15128,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15241,20 +15142,20 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) (append - #{c\ 4323}# + #{c\ 4382}# (list (cons '#(syntax-object doloop ((top) @@ -15265,7 +15166,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15279,12 +15180,12 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () @@ -15292,30 +15193,30 @@ #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) - #{step\ 4328}#))))))) - #{tmp\ 4330}#) - (let ((#{tmp\ 4335}# + #{step\ 4387}#))))))) + #{tmp\ 4389}#) + (let ((#{tmp\ 4394}# ($sc-dispatch - #{tmp\ 4329}# + #{tmp\ 4388}# '(any . each-any)))) - (if #{tmp\ 4335}# + (if #{tmp\ 4394}# (@apply - (lambda (#{e1\ 4338}# #{e2\ 4339}#) + (lambda (#{e1\ 4397}# #{e2\ 4398}#) (list '#(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4336" "i4337")) + #("i4395" "i4396")) #(ribcage () () ()) #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15324,17 +15225,17 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) '#(syntax-object doloop @@ -15342,12 +15243,12 @@ #(ribcage #(e1 e2) #((top) (top)) - #("i4336" "i4337")) + #("i4395" "i4396")) #(ribcage () () ()) #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init step e0 e1 c) #((top) @@ -15356,33 +15257,33 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) (map list - #{var\ 4318}# - #{init\ 4319}#) + #{var\ 4377}# + #{init\ 4378}#) (list '#(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4336" "i4337")) + #("i4395" "i4396")) #(ribcage () () ()) #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15396,27 +15297,27 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) - #{e0\ 4321}# + #{e0\ 4380}# (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4336" - "i4337")) + #("i4395" + "i4396")) #(ribcage () () @@ -15424,7 +15325,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15438,12 +15339,12 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () @@ -15451,18 +15352,18 @@ #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) - (cons #{e1\ 4338}# - #{e2\ 4339}#)) + (cons #{e1\ 4397}# + #{e2\ 4398}#)) (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4336" - "i4337")) + #("i4395" + "i4396")) #(ribcage () () @@ -15470,7 +15371,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15484,12 +15385,12 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () @@ -15497,10 +15398,10 @@ #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) (append - #{c\ 4323}# + #{c\ 4382}# (list (cons '#(syntax-object doloop ((top) @@ -15509,8 +15410,8 @@ e2) #((top) (top)) - #("i4336" - "i4337")) + #("i4395" + "i4396")) #(ribcage () () @@ -15518,7 +15419,7 @@ #(ribcage #(step) #((top)) - #("i4327")) + #("i4386")) #(ribcage #(var init @@ -15532,12 +15433,12 @@ (top) (top) (top)) - #("i4312" - "i4313" - "i4314" - "i4315" - "i4316" - "i4317")) + #("i4371" + "i4372" + "i4373" + "i4374" + "i4375" + "i4376")) #(ribcage () () @@ -15545,37 +15446,37 @@ #(ribcage #(orig-x) #((top)) - #("i4309"))) + #("i4368"))) (hygiene guile)) - #{step\ 4328}#))))))) - #{tmp\ 4335}#) + #{step\ 4387}#))))))) + #{tmp\ 4394}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4329}#))))))) - #{tmp\ 4326}#) + #{tmp\ 4388}#))))))) + #{tmp\ 4385}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4325}#))))) - #{tmp\ 4311}#) + #{tmp\ 4384}#))))) + #{tmp\ 4370}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4310}#))))))) + #{tmp\ 4369}#))))))) (define quasiquote (make-syntax-transformer 'quasiquote 'macro (letrec* - ((#{quasi\ 4360}# - (lambda (#{p\ 4373}# #{lev\ 4374}#) - (let ((#{tmp\ 4377}# #{p\ 4373}#)) - (let ((#{tmp\ 4378}# + ((#{quasi\ 4419}# + (lambda (#{p\ 4432}# #{lev\ 4433}#) + (let ((#{tmp\ 4436}# #{p\ 4432}#)) + (let ((#{tmp\ 4437}# ($sc-dispatch - #{tmp\ 4377}# + #{tmp\ 4436}# '(#(free-id #(syntax-object unquote @@ -15584,7 +15485,7 @@ #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15593,28 +15494,28 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) any)))) - (if #{tmp\ 4378}# + (if #{tmp\ 4437}# (@apply - (lambda (#{p\ 4380}#) - (if (= #{lev\ 4374}# 0) + (lambda (#{p\ 4439}#) + (if (= #{lev\ 4433}# 0) (list '#(syntax-object "value" ((top) - #(ribcage #(p) #((top)) #("i4379")) + #(ribcage #(p) #((top)) #("i4438")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15623,25 +15524,25 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{p\ 4380}#) - (#{quasicons\ 4364}# + #{p\ 4439}#) + (#{quasicons\ 4423}# '(#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4379")) + #(ribcage #(p) #((top)) #("i4438")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15650,23 +15551,23 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) #(syntax-object unquote ((top) - #(ribcage #(p) #((top)) #("i4379")) + #(ribcage #(p) #((top)) #("i4438")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15675,21 +15576,21 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) - (#{quasi\ 4360}# - (list #{p\ 4380}#) - (1- #{lev\ 4374}#))))) - #{tmp\ 4378}#) - (let ((#{tmp\ 4381}# + (#{quasi\ 4419}# + (list #{p\ 4439}#) + (1- #{lev\ 4433}#))))) + #{tmp\ 4437}#) + (let ((#{tmp\ 4440}# ($sc-dispatch - #{tmp\ 4377}# + #{tmp\ 4436}# '(#(free-id #(syntax-object quasiquote @@ -15698,7 +15599,7 @@ #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15707,28 +15608,28 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) any)))) - (if #{tmp\ 4381}# + (if #{tmp\ 4440}# (@apply - (lambda (#{p\ 4383}#) - (#{quasicons\ 4364}# + (lambda (#{p\ 4442}#) + (#{quasicons\ 4423}# '(#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4382")) + #(ribcage #(p) #((top)) #("i4441")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15737,23 +15638,23 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) #(syntax-object quasiquote ((top) - #(ribcage #(p) #((top)) #("i4382")) + #(ribcage #(p) #((top)) #("i4441")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15762,27 +15663,27 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) - (#{quasi\ 4360}# - (list #{p\ 4383}#) - (1+ #{lev\ 4374}#)))) - #{tmp\ 4381}#) - (let ((#{tmp\ 4384}# - ($sc-dispatch #{tmp\ 4377}# '(any . any)))) - (if #{tmp\ 4384}# + (#{quasi\ 4419}# + (list #{p\ 4442}#) + (1+ #{lev\ 4433}#)))) + #{tmp\ 4440}#) + (let ((#{tmp\ 4443}# + ($sc-dispatch #{tmp\ 4436}# '(any . any)))) + (if #{tmp\ 4443}# (@apply - (lambda (#{p\ 4387}# #{q\ 4388}#) - (let ((#{tmp\ 4389}# #{p\ 4387}#)) - (let ((#{tmp\ 4390}# + (lambda (#{p\ 4446}# #{q\ 4447}#) + (let ((#{tmp\ 4448}# #{p\ 4446}#)) + (let ((#{tmp\ 4449}# ($sc-dispatch - #{tmp\ 4389}# + #{tmp\ 4448}# '(#(free-id #(syntax-object unquote @@ -15790,12 +15691,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4385" "i4386")) + #("i4444" "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15810,40 +15711,40 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4390}# + (if #{tmp\ 4449}# (@apply - (lambda (#{p\ 4392}#) - (if (= #{lev\ 4374}# 0) - (#{quasilist*\ 4368}# - (map (lambda (#{tmp\ 4393}#) + (lambda (#{p\ 4451}#) + (if (= #{lev\ 4433}# 0) + (#{quasilist*\ 4427}# + (map (lambda (#{tmp\ 4452}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4391")) + #("i4450")) #(ribcage #(p q) #((top) (top)) - #("i4385" - "i4386")) + #("i4444" + "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" - "i4376")) + #("i4434" + "i4435")) #(ribcage (emit quasivector quasilist* @@ -15858,37 +15759,37 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{tmp\ 4393}#)) - #{p\ 4392}#) - (#{quasi\ 4360}# - #{q\ 4388}# - #{lev\ 4374}#)) - (#{quasicons\ 4364}# - (#{quasicons\ 4364}# + #{tmp\ 4452}#)) + #{p\ 4451}#) + (#{quasi\ 4419}# + #{q\ 4447}# + #{lev\ 4433}#)) + (#{quasicons\ 4423}# + (#{quasicons\ 4423}# '(#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) - #("i4391")) + #("i4450")) #(ribcage #(p q) #((top) (top)) - #("i4385" "i4386")) + #("i4444" "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15903,13 +15804,13 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) #(syntax-object unquote @@ -15917,16 +15818,16 @@ #(ribcage #(p) #((top)) - #("i4391")) + #("i4450")) #(ribcage #(p q) #((top) (top)) - #("i4385" "i4386")) + #("i4444" "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15941,24 +15842,24 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) - (#{quasi\ 4360}# - #{p\ 4392}# - (1- #{lev\ 4374}#))) - (#{quasi\ 4360}# - #{q\ 4388}# - #{lev\ 4374}#)))) - #{tmp\ 4390}#) - (let ((#{tmp\ 4395}# + (#{quasi\ 4419}# + #{p\ 4451}# + (1- #{lev\ 4433}#))) + (#{quasi\ 4419}# + #{q\ 4447}# + #{lev\ 4433}#)))) + #{tmp\ 4449}#) + (let ((#{tmp\ 4454}# ($sc-dispatch - #{tmp\ 4389}# + #{tmp\ 4448}# '(#(free-id #(syntax-object unquote-splicing @@ -15966,12 +15867,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4385" "i4386")) + #("i4444" "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -15986,35 +15887,35 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4395}# + (if #{tmp\ 4454}# (@apply - (lambda (#{p\ 4397}#) - (if (= #{lev\ 4374}# 0) - (#{quasiappend\ 4366}# - (map (lambda (#{tmp\ 4398}#) + (lambda (#{p\ 4456}#) + (if (= #{lev\ 4433}# 0) + (#{quasiappend\ 4425}# + (map (lambda (#{tmp\ 4457}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4396")) + #("i4455")) #(ribcage #(p q) #((top) (top)) - #("i4385" - "i4386")) + #("i4444" + "i4445")) #(ribcage () () @@ -16023,8 +15924,8 @@ #(p lev) #((top) (top)) - #("i4375" - "i4376")) + #("i4434" + "i4435")) #(ribcage (emit quasivector quasilist* @@ -16039,37 +15940,37 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{tmp\ 4398}#)) - #{p\ 4397}#) - (#{quasi\ 4360}# - #{q\ 4388}# - #{lev\ 4374}#)) - (#{quasicons\ 4364}# - (#{quasicons\ 4364}# + #{tmp\ 4457}#)) + #{p\ 4456}#) + (#{quasi\ 4419}# + #{q\ 4447}# + #{lev\ 4433}#)) + (#{quasicons\ 4423}# + (#{quasicons\ 4423}# '(#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) - #("i4396")) + #("i4455")) #(ribcage #(p q) #((top) (top)) - #("i4385" "i4386")) + #("i4444" "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16084,13 +15985,13 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) #(syntax-object unquote-splicing @@ -16098,16 +15999,16 @@ #(ribcage #(p) #((top)) - #("i4396")) + #("i4455")) #(ribcage #(p q) #((top) (top)) - #("i4385" "i4386")) + #("i4444" "i4445")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16122,52 +16023,52 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) - (#{quasi\ 4360}# - #{p\ 4397}# - (1- #{lev\ 4374}#))) - (#{quasi\ 4360}# - #{q\ 4388}# - #{lev\ 4374}#)))) - #{tmp\ 4395}#) - (let ((#{_\ 4401}# #{tmp\ 4389}#)) - (#{quasicons\ 4364}# - (#{quasi\ 4360}# - #{p\ 4387}# - #{lev\ 4374}#) - (#{quasi\ 4360}# - #{q\ 4388}# - #{lev\ 4374}#))))))))) - #{tmp\ 4384}#) - (let ((#{tmp\ 4402}# + (#{quasi\ 4419}# + #{p\ 4456}# + (1- #{lev\ 4433}#))) + (#{quasi\ 4419}# + #{q\ 4447}# + #{lev\ 4433}#)))) + #{tmp\ 4454}#) + (let ((#{_\ 4460}# #{tmp\ 4448}#)) + (#{quasicons\ 4423}# + (#{quasi\ 4419}# + #{p\ 4446}# + #{lev\ 4433}#) + (#{quasi\ 4419}# + #{q\ 4447}# + #{lev\ 4433}#))))))))) + #{tmp\ 4443}#) + (let ((#{tmp\ 4461}# ($sc-dispatch - #{tmp\ 4377}# + #{tmp\ 4436}# '#(vector each-any)))) - (if #{tmp\ 4402}# + (if #{tmp\ 4461}# (@apply - (lambda (#{x\ 4404}#) - (#{quasivector\ 4370}# - (#{vquasi\ 4362}# - #{x\ 4404}# - #{lev\ 4374}#))) - #{tmp\ 4402}#) - (let ((#{p\ 4407}# #{tmp\ 4377}#)) + (lambda (#{x\ 4463}#) + (#{quasivector\ 4429}# + (#{vquasi\ 4421}# + #{x\ 4463}# + #{lev\ 4433}#))) + #{tmp\ 4461}#) + (let ((#{p\ 4466}# #{tmp\ 4436}#)) (list '#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4406")) + #(ribcage #(p) #((top)) #("i4465")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4375" "i4376")) + #("i4434" "i4435")) #(ribcage (emit quasivector quasilist* @@ -16182,27 +16083,27 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{p\ 4407}#))))))))))))) - (#{vquasi\ 4362}# - (lambda (#{p\ 4408}# #{lev\ 4409}#) - (let ((#{tmp\ 4412}# #{p\ 4408}#)) - (let ((#{tmp\ 4413}# - ($sc-dispatch #{tmp\ 4412}# '(any . any)))) - (if #{tmp\ 4413}# + #{p\ 4466}#))))))))))))) + (#{vquasi\ 4421}# + (lambda (#{p\ 4467}# #{lev\ 4468}#) + (let ((#{tmp\ 4471}# #{p\ 4467}#)) + (let ((#{tmp\ 4472}# + ($sc-dispatch #{tmp\ 4471}# '(any . any)))) + (if #{tmp\ 4472}# (@apply - (lambda (#{p\ 4416}# #{q\ 4417}#) - (let ((#{tmp\ 4418}# #{p\ 4416}#)) - (let ((#{tmp\ 4419}# + (lambda (#{p\ 4475}# #{q\ 4476}#) + (let ((#{tmp\ 4477}# #{p\ 4475}#)) + (let ((#{tmp\ 4478}# ($sc-dispatch - #{tmp\ 4418}# + #{tmp\ 4477}# '(#(free-id #(syntax-object unquote @@ -16210,12 +16111,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16230,38 +16131,38 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4419}# + (if #{tmp\ 4478}# (@apply - (lambda (#{p\ 4421}#) - (if (= #{lev\ 4409}# 0) - (#{quasilist*\ 4368}# - (map (lambda (#{tmp\ 4422}#) + (lambda (#{p\ 4480}#) + (if (= #{lev\ 4468}# 0) + (#{quasilist*\ 4427}# + (map (lambda (#{tmp\ 4481}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4420")) + #("i4479")) #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16276,34 +16177,34 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{tmp\ 4422}#)) - #{p\ 4421}#) - (#{vquasi\ 4362}# - #{q\ 4417}# - #{lev\ 4409}#)) - (#{quasicons\ 4364}# - (#{quasicons\ 4364}# + #{tmp\ 4481}#)) + #{p\ 4480}#) + (#{vquasi\ 4421}# + #{q\ 4476}# + #{lev\ 4468}#)) + (#{quasicons\ 4423}# + (#{quasicons\ 4423}# '(#(syntax-object "quote" ((top) - #(ribcage #(p) #((top)) #("i4420")) + #(ribcage #(p) #((top)) #("i4479")) #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16318,27 +16219,27 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) #(syntax-object unquote ((top) - #(ribcage #(p) #((top)) #("i4420")) + #(ribcage #(p) #((top)) #("i4479")) #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16353,24 +16254,24 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) - (#{quasi\ 4360}# - #{p\ 4421}# - (1- #{lev\ 4409}#))) - (#{vquasi\ 4362}# - #{q\ 4417}# - #{lev\ 4409}#)))) - #{tmp\ 4419}#) - (let ((#{tmp\ 4424}# + (#{quasi\ 4419}# + #{p\ 4480}# + (1- #{lev\ 4468}#))) + (#{vquasi\ 4421}# + #{q\ 4476}# + #{lev\ 4468}#)))) + #{tmp\ 4478}#) + (let ((#{tmp\ 4483}# ($sc-dispatch - #{tmp\ 4418}# + #{tmp\ 4477}# '(#(free-id #(syntax-object unquote-splicing @@ -16378,12 +16279,12 @@ #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16398,38 +16299,38 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) . each-any)))) - (if #{tmp\ 4424}# + (if #{tmp\ 4483}# (@apply - (lambda (#{p\ 4426}#) - (if (= #{lev\ 4409}# 0) - (#{quasiappend\ 4366}# - (map (lambda (#{tmp\ 4427}#) + (lambda (#{p\ 4485}#) + (if (= #{lev\ 4468}# 0) + (#{quasiappend\ 4425}# + (map (lambda (#{tmp\ 4486}#) (list '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) - #("i4425")) + #("i4484")) #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16444,37 +16345,37 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{tmp\ 4427}#)) - #{p\ 4426}#) - (#{vquasi\ 4362}# - #{q\ 4417}# - #{lev\ 4409}#)) - (#{quasicons\ 4364}# - (#{quasicons\ 4364}# + #{tmp\ 4486}#)) + #{p\ 4485}#) + (#{vquasi\ 4421}# + #{q\ 4476}# + #{lev\ 4468}#)) + (#{quasicons\ 4423}# + (#{quasicons\ 4423}# '(#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) - #("i4425")) + #("i4484")) #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16489,13 +16390,13 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) #(syntax-object unquote-splicing @@ -16503,16 +16404,16 @@ #(ribcage #(p) #((top)) - #("i4425")) + #("i4484")) #(ribcage #(p q) #((top) (top)) - #("i4414" "i4415")) + #("i4473" "i4474")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16527,30 +16428,30 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile))) - (#{quasi\ 4360}# - #{p\ 4426}# - (1- #{lev\ 4409}#))) - (#{vquasi\ 4362}# - #{q\ 4417}# - #{lev\ 4409}#)))) - #{tmp\ 4424}#) - (let ((#{_\ 4430}# #{tmp\ 4418}#)) - (#{quasicons\ 4364}# - (#{quasi\ 4360}# #{p\ 4416}# #{lev\ 4409}#) - (#{vquasi\ 4362}# - #{q\ 4417}# - #{lev\ 4409}#))))))))) - #{tmp\ 4413}#) - (let ((#{tmp\ 4431}# ($sc-dispatch #{tmp\ 4412}# '()))) - (if #{tmp\ 4431}# + (#{quasi\ 4419}# + #{p\ 4485}# + (1- #{lev\ 4468}#))) + (#{vquasi\ 4421}# + #{q\ 4476}# + #{lev\ 4468}#)))) + #{tmp\ 4483}#) + (let ((#{_\ 4489}# #{tmp\ 4477}#)) + (#{quasicons\ 4423}# + (#{quasi\ 4419}# #{p\ 4475}# #{lev\ 4468}#) + (#{vquasi\ 4421}# + #{q\ 4476}# + #{lev\ 4468}#))))))))) + #{tmp\ 4472}#) + (let ((#{tmp\ 4490}# ($sc-dispatch #{tmp\ 4471}# '()))) + (if #{tmp\ 4490}# (@apply (lambda () '(#(syntax-object @@ -16560,7 +16461,7 @@ #(ribcage #(p lev) #((top) (top)) - #("i4410" "i4411")) + #("i4469" "i4470")) #(ribcage (emit quasivector quasilist* @@ -16569,66 +16470,66 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) ())) - #{tmp\ 4431}#) + #{tmp\ 4490}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4412}#)))))))) - (#{quasicons\ 4364}# - (lambda (#{x\ 4432}# #{y\ 4433}#) - (let ((#{tmp\ 4437}# (list #{x\ 4432}# #{y\ 4433}#))) - (let ((#{tmp\ 4438}# - ($sc-dispatch #{tmp\ 4437}# '(any any)))) - (if #{tmp\ 4438}# + #{tmp\ 4471}#)))))))) + (#{quasicons\ 4423}# + (lambda (#{x\ 4491}# #{y\ 4492}#) + (let ((#{tmp\ 4496}# (list #{x\ 4491}# #{y\ 4492}#))) + (let ((#{tmp\ 4497}# + ($sc-dispatch #{tmp\ 4496}# '(any any)))) + (if #{tmp\ 4497}# (@apply - (lambda (#{x\ 4441}# #{y\ 4442}#) - (let ((#{tmp\ 4443}# #{y\ 4442}#)) - (let ((#{tmp\ 4444}# + (lambda (#{x\ 4500}# #{y\ 4501}#) + (let ((#{tmp\ 4502}# #{y\ 4501}#)) + (let ((#{tmp\ 4503}# ($sc-dispatch - #{tmp\ 4443}# + #{tmp\ 4502}# '(#(atom "quote") any)))) - (if #{tmp\ 4444}# + (if #{tmp\ 4503}# (@apply - (lambda (#{dy\ 4446}#) - (let ((#{tmp\ 4447}# #{x\ 4441}#)) - (let ((#{tmp\ 4448}# + (lambda (#{dy\ 4505}#) + (let ((#{tmp\ 4506}# #{x\ 4500}#)) + (let ((#{tmp\ 4507}# ($sc-dispatch - #{tmp\ 4447}# + #{tmp\ 4506}# '(#(atom "quote") any)))) - (if #{tmp\ 4448}# + (if #{tmp\ 4507}# (@apply - (lambda (#{dx\ 4450}#) + (lambda (#{dx\ 4509}#) (list '#(syntax-object "quote" ((top) #(ribcage #(dx) #((top)) - #("i4449")) + #("i4508")) #(ribcage #(dy) #((top)) - #("i4445")) + #("i4504")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4439" "i4440")) + #("i4498" "i4499")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4434" "i4435")) + #("i4493" "i4494")) #(ribcage (emit quasivector quasilist* @@ -16643,41 +16544,41 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - (cons #{dx\ 4450}# - #{dy\ 4446}#))) - #{tmp\ 4448}#) - (let ((#{_\ 4452}# #{tmp\ 4447}#)) - (if (null? #{dy\ 4446}#) + (cons #{dx\ 4509}# + #{dy\ 4505}#))) + #{tmp\ 4507}#) + (let ((#{_\ 4511}# #{tmp\ 4506}#)) + (if (null? #{dy\ 4505}#) (list '#(syntax-object "list" ((top) #(ribcage #(_) #((top)) - #("i4451")) + #("i4510")) #(ribcage #(dy) #((top)) - #("i4445")) + #("i4504")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4439" "i4440")) + #("i4498" "i4499")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4434" "i4435")) + #("i4493" "i4494")) #(ribcage (emit quasivector quasilist* @@ -16692,37 +16593,37 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{x\ 4441}#) + #{x\ 4500}#) (list '#(syntax-object "list*" ((top) #(ribcage #(_) #((top)) - #("i4451")) + #("i4510")) #(ribcage #(dy) #((top)) - #("i4445")) + #("i4504")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4439" "i4440")) + #("i4498" "i4499")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4434" "i4435")) + #("i4493" "i4494")) #(ribcage (emit quasivector quasilist* @@ -16737,42 +16638,42 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{x\ 4441}# - #{y\ 4442}#))))))) - #{tmp\ 4444}#) - (let ((#{tmp\ 4453}# + #{x\ 4500}# + #{y\ 4501}#))))))) + #{tmp\ 4503}#) + (let ((#{tmp\ 4512}# ($sc-dispatch - #{tmp\ 4443}# + #{tmp\ 4502}# '(#(atom "list") . any)))) - (if #{tmp\ 4453}# + (if #{tmp\ 4512}# (@apply - (lambda (#{stuff\ 4455}#) + (lambda (#{stuff\ 4514}#) (cons '#(syntax-object "list" ((top) #(ribcage #(stuff) #((top)) - #("i4454")) + #("i4513")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4439" "i4440")) + #("i4498" "i4499")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4434" "i4435")) + #("i4493" "i4494")) #(ribcage (emit quasivector quasilist* @@ -16787,41 +16688,41 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - (cons #{x\ 4441}# #{stuff\ 4455}#))) - #{tmp\ 4453}#) - (let ((#{tmp\ 4456}# + (cons #{x\ 4500}# #{stuff\ 4514}#))) + #{tmp\ 4512}#) + (let ((#{tmp\ 4515}# ($sc-dispatch - #{tmp\ 4443}# + #{tmp\ 4502}# '(#(atom "list*") . any)))) - (if #{tmp\ 4456}# + (if #{tmp\ 4515}# (@apply - (lambda (#{stuff\ 4458}#) + (lambda (#{stuff\ 4517}#) (cons '#(syntax-object "list*" ((top) #(ribcage #(stuff) #((top)) - #("i4457")) + #("i4516")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4439" "i4440")) + #("i4498" "i4499")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4434" "i4435")) + #("i4493" "i4494")) #(ribcage (emit quasivector quasilist* @@ -16836,36 +16737,36 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - (cons #{x\ 4441}# - #{stuff\ 4458}#))) - #{tmp\ 4456}#) - (let ((#{_\ 4460}# #{tmp\ 4443}#)) + (cons #{x\ 4500}# + #{stuff\ 4517}#))) + #{tmp\ 4515}#) + (let ((#{_\ 4519}# #{tmp\ 4502}#)) (list '#(syntax-object "list*" ((top) #(ribcage #(_) #((top)) - #("i4459")) + #("i4518")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4439" "i4440")) + #("i4498" "i4499")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4434" "i4435")) + #("i4493" "i4494")) #(ribcage (emit quasivector quasilist* @@ -16880,32 +16781,32 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{x\ 4441}# - #{y\ 4442}#)))))))))) - #{tmp\ 4438}#) + #{x\ 4500}# + #{y\ 4501}#)))))))))) + #{tmp\ 4497}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4437}#)))))) - (#{quasiappend\ 4366}# - (lambda (#{x\ 4461}# #{y\ 4462}#) - (let ((#{tmp\ 4465}# #{y\ 4462}#)) - (let ((#{tmp\ 4466}# + #{tmp\ 4496}#)))))) + (#{quasiappend\ 4425}# + (lambda (#{x\ 4520}# #{y\ 4521}#) + (let ((#{tmp\ 4524}# #{y\ 4521}#)) + (let ((#{tmp\ 4525}# ($sc-dispatch - #{tmp\ 4465}# + #{tmp\ 4524}# '(#(atom "quote") ())))) - (if #{tmp\ 4466}# + (if #{tmp\ 4525}# (@apply (lambda () - (if (null? #{x\ 4461}#) + (if (null? #{x\ 4520}#) '(#(syntax-object "quote" ((top) @@ -16913,7 +16814,7 @@ #(ribcage #(x y) #((top) (top)) - #("i4463" "i4464")) + #("i4522" "i4523")) #(ribcage (emit quasivector quasilist* @@ -16922,23 +16823,23 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) ()) - (if (null? (cdr #{x\ 4461}#)) - (car #{x\ 4461}#) - (let ((#{tmp\ 4473}# #{x\ 4461}#)) - (let ((#{tmp\ 4474}# - ($sc-dispatch #{tmp\ 4473}# 'each-any))) - (if #{tmp\ 4474}# + (if (null? (cdr #{x\ 4520}#)) + (car #{x\ 4520}#) + (let ((#{tmp\ 4532}# #{x\ 4520}#)) + (let ((#{tmp\ 4533}# + ($sc-dispatch #{tmp\ 4532}# 'each-any))) + (if #{tmp\ 4533}# (@apply - (lambda (#{p\ 4476}#) + (lambda (#{p\ 4535}#) (cons '#(syntax-object "append" ((top) @@ -16946,12 +16847,12 @@ #(ribcage #(p) #((top)) - #("i4475")) + #("i4534")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4463" "i4464")) + #("i4522" "i4523")) #(ribcage (emit quasivector quasilist* @@ -16966,30 +16867,30 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{p\ 4476}#)) - #{tmp\ 4474}#) + #{p\ 4535}#)) + #{tmp\ 4533}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4473}#))))))) - #{tmp\ 4466}#) - (let ((#{_\ 4479}# #{tmp\ 4465}#)) - (if (null? #{x\ 4461}#) - #{y\ 4462}# - (let ((#{tmp\ 4484}# (list #{x\ 4461}# #{y\ 4462}#))) - (let ((#{tmp\ 4485}# - ($sc-dispatch #{tmp\ 4484}# '(each-any any)))) - (if #{tmp\ 4485}# + #{tmp\ 4532}#))))))) + #{tmp\ 4525}#) + (let ((#{_\ 4538}# #{tmp\ 4524}#)) + (if (null? #{x\ 4520}#) + #{y\ 4521}# + (let ((#{tmp\ 4543}# (list #{x\ 4520}# #{y\ 4521}#))) + (let ((#{tmp\ 4544}# + ($sc-dispatch #{tmp\ 4543}# '(each-any any)))) + (if #{tmp\ 4544}# (@apply - (lambda (#{p\ 4488}# #{y\ 4489}#) + (lambda (#{p\ 4547}# #{y\ 4548}#) (cons '#(syntax-object "append" ((top) @@ -16997,13 +16898,13 @@ #(ribcage #(p y) #((top) (top)) - #("i4486" "i4487")) - #(ribcage #(_) #((top)) #("i4478")) + #("i4545" "i4546")) + #(ribcage #(_) #((top)) #("i4537")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) - #("i4463" "i4464")) + #("i4522" "i4523")) #(ribcage (emit quasivector quasilist* @@ -17018,47 +16919,47 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - (append #{p\ 4488}# (list #{y\ 4489}#)))) - #{tmp\ 4485}#) + (append #{p\ 4547}# (list #{y\ 4548}#)))) + #{tmp\ 4544}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4484}#))))))))))) - (#{quasilist*\ 4368}# - (lambda (#{x\ 4491}# #{y\ 4492}#) + #{tmp\ 4543}#))))))))))) + (#{quasilist*\ 4427}# + (lambda (#{x\ 4550}# #{y\ 4551}#) (letrec* - ((#{f\ 4497}# - (lambda (#{x\ 4498}#) - (if (null? #{x\ 4498}#) - #{y\ 4492}# - (#{quasicons\ 4364}# - (car #{x\ 4498}#) - (#{f\ 4497}# (cdr #{x\ 4498}#))))))) - (begin (#{f\ 4497}# #{x\ 4491}#))))) - (#{quasivector\ 4370}# - (lambda (#{x\ 4499}#) - (let ((#{tmp\ 4501}# #{x\ 4499}#)) - (let ((#{tmp\ 4502}# + ((#{f\ 4556}# + (lambda (#{x\ 4557}#) + (if (null? #{x\ 4557}#) + #{y\ 4551}# + (#{quasicons\ 4423}# + (car #{x\ 4557}#) + (#{f\ 4556}# (cdr #{x\ 4557}#))))))) + (begin (#{f\ 4556}# #{x\ 4550}#))))) + (#{quasivector\ 4429}# + (lambda (#{x\ 4558}#) + (let ((#{tmp\ 4560}# #{x\ 4558}#)) + (let ((#{tmp\ 4561}# ($sc-dispatch - #{tmp\ 4501}# + #{tmp\ 4560}# '(#(atom "quote") each-any)))) - (if #{tmp\ 4502}# + (if #{tmp\ 4561}# (@apply - (lambda (#{x\ 4504}#) + (lambda (#{x\ 4563}#) (list '#(syntax-object "quote" ((top) - #(ribcage #(x) #((top)) #("i4503")) + #(ribcage #(x) #((top)) #("i4562")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4500")) + #(ribcage #(x) #((top)) #("i4559")) #(ribcage (emit quasivector quasilist* @@ -17067,53 +16968,53 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - (list->vector #{x\ 4504}#))) - #{tmp\ 4502}#) - (let ((#{_\ 4507}# #{tmp\ 4501}#)) + (list->vector #{x\ 4563}#))) + #{tmp\ 4561}#) + (let ((#{_\ 4566}# #{tmp\ 4560}#)) (letrec* - ((#{f\ 4511}# - (lambda (#{y\ 4512}# #{k\ 4513}#) - (let ((#{tmp\ 4524}# #{y\ 4512}#)) - (let ((#{tmp\ 4525}# + ((#{f\ 4570}# + (lambda (#{y\ 4571}# #{k\ 4572}#) + (let ((#{tmp\ 4583}# #{y\ 4571}#)) + (let ((#{tmp\ 4584}# ($sc-dispatch - #{tmp\ 4524}# + #{tmp\ 4583}# '(#(atom "quote") each-any)))) - (if #{tmp\ 4525}# + (if #{tmp\ 4584}# (@apply - (lambda (#{y\ 4527}#) - (#{k\ 4513}# - (map (lambda (#{tmp\ 4528}#) + (lambda (#{y\ 4586}#) + (#{k\ 4572}# + (map (lambda (#{tmp\ 4587}#) (list '#(syntax-object "quote" ((top) #(ribcage #(y) #((top)) - #("i4526")) + #("i4585")) #(ribcage () () ()) #(ribcage #(f y k) #((top) (top) (top)) - #("i4508" - "i4509" - "i4510")) + #("i4567" + "i4568" + "i4569")) #(ribcage #(_) #((top)) - #("i4506")) + #("i4565")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4500")) + #("i4559")) #(ribcage (emit quasivector quasilist* @@ -17128,75 +17029,75 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{tmp\ 4528}#)) - #{y\ 4527}#))) - #{tmp\ 4525}#) - (let ((#{tmp\ 4529}# + #{tmp\ 4587}#)) + #{y\ 4586}#))) + #{tmp\ 4584}#) + (let ((#{tmp\ 4588}# ($sc-dispatch - #{tmp\ 4524}# + #{tmp\ 4583}# '(#(atom "list") . each-any)))) - (if #{tmp\ 4529}# + (if #{tmp\ 4588}# (@apply - (lambda (#{y\ 4531}#) - (#{k\ 4513}# #{y\ 4531}#)) - #{tmp\ 4529}#) - (let ((#{tmp\ 4533}# + (lambda (#{y\ 4590}#) + (#{k\ 4572}# #{y\ 4590}#)) + #{tmp\ 4588}#) + (let ((#{tmp\ 4592}# ($sc-dispatch - #{tmp\ 4524}# + #{tmp\ 4583}# '(#(atom "list*") . #(each+ any (any) ()))))) - (if #{tmp\ 4533}# + (if #{tmp\ 4592}# (@apply - (lambda (#{y\ 4536}# #{z\ 4537}#) - (#{f\ 4511}# - #{z\ 4537}# - (lambda (#{ls\ 4538}#) - (#{k\ 4513}# + (lambda (#{y\ 4595}# #{z\ 4596}#) + (#{f\ 4570}# + #{z\ 4596}# + (lambda (#{ls\ 4597}#) + (#{k\ 4572}# (append - #{y\ 4536}# - #{ls\ 4538}#))))) - #{tmp\ 4533}#) - (let ((#{else\ 4542}# #{tmp\ 4524}#)) - (let ((#{tmp\ 4546}# #{x\ 4499}#)) - (let ((#{\ g4543\ 4548}# - #{tmp\ 4546}#)) + #{y\ 4595}# + #{ls\ 4597}#))))) + #{tmp\ 4592}#) + (let ((#{else\ 4601}# #{tmp\ 4583}#)) + (let ((#{tmp\ 4605}# #{x\ 4558}#)) + (let ((#{\ g4602\ 4607}# + #{tmp\ 4605}#)) (list '#(syntax-object "list->vector" ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4543}#) - #((m4544 top)) - #("i4547")) + #(#{\ g4602}#) + #((m4603 top)) + #("i4606")) #(ribcage #(else) #((top)) - #("i4541")) + #("i4600")) #(ribcage () () ()) #(ribcage #(f y k) #((top) (top) (top)) - #("i4508" - "i4509" - "i4510")) + #("i4567" + "i4568" + "i4569")) #(ribcage #(_) #((top)) - #("i4506")) + #("i4565")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4500")) + #("i4559")) #(ribcage (emit quasivector quasilist* @@ -17211,49 +17112,49 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4543\ 4548}#)))))))))))))) + #{\ g4602\ 4607}#)))))))))))))) (begin - (#{f\ 4511}# - #{x\ 4499}# - (lambda (#{ls\ 4514}#) - (let ((#{tmp\ 4519}# #{ls\ 4514}#)) - (let ((#{tmp\ 4520}# - ($sc-dispatch #{tmp\ 4519}# 'each-any))) - (if #{tmp\ 4520}# + (#{f\ 4570}# + #{x\ 4558}# + (lambda (#{ls\ 4573}#) + (let ((#{tmp\ 4578}# #{ls\ 4573}#)) + (let ((#{tmp\ 4579}# + ($sc-dispatch #{tmp\ 4578}# 'each-any))) + (if #{tmp\ 4579}# (@apply - (lambda (#{\ g4516\ 4522}#) + (lambda (#{\ g4575\ 4581}#) (cons '#(syntax-object "vector" ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4516}#) - #((m4517 top)) - #("i4521")) + #(#{\ g4575}#) + #((m4576 top)) + #("i4580")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ls) #((top)) - #("i4515")) + #("i4574")) #(ribcage #(_) #((top)) - #("i4506")) + #("i4565")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4500")) + #("i4559")) #(ribcage (emit quasivector quasilist* @@ -17268,36 +17169,36 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4516\ 4522}#)) - #{tmp\ 4520}#) + #{\ g4575\ 4581}#)) + #{tmp\ 4579}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4519}#)))))))))))))) - (#{emit\ 4372}# - (lambda (#{x\ 4549}#) - (let ((#{tmp\ 4551}# #{x\ 4549}#)) - (let ((#{tmp\ 4552}# + #{tmp\ 4578}#)))))))))))))) + (#{emit\ 4431}# + (lambda (#{x\ 4608}#) + (let ((#{tmp\ 4610}# #{x\ 4608}#)) + (let ((#{tmp\ 4611}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "quote") any)))) - (if #{tmp\ 4552}# + (if #{tmp\ 4611}# (@apply - (lambda (#{x\ 4554}#) + (lambda (#{x\ 4613}#) (list '#(syntax-object quote ((top) - #(ribcage #(x) #((top)) #("i4553")) + #(ribcage #(x) #((top)) #("i4612")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4550")) + #(ribcage #(x) #((top)) #("i4609")) #(ribcage (emit quasivector quasilist* @@ -17306,47 +17207,47 @@ vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{x\ 4554}#)) - #{tmp\ 4552}#) - (let ((#{tmp\ 4555}# + #{x\ 4613}#)) + #{tmp\ 4611}#) + (let ((#{tmp\ 4614}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "list") . each-any)))) - (if #{tmp\ 4555}# + (if #{tmp\ 4614}# (@apply - (lambda (#{x\ 4557}#) - (let ((#{tmp\ 4561}# - (map #{emit\ 4372}# #{x\ 4557}#))) - (let ((#{tmp\ 4562}# - ($sc-dispatch #{tmp\ 4561}# 'each-any))) - (if #{tmp\ 4562}# + (lambda (#{x\ 4616}#) + (let ((#{tmp\ 4620}# + (map #{emit\ 4431}# #{x\ 4616}#))) + (let ((#{tmp\ 4621}# + ($sc-dispatch #{tmp\ 4620}# 'each-any))) + (if #{tmp\ 4621}# (@apply - (lambda (#{\ g4558\ 4564}#) + (lambda (#{\ g4617\ 4623}#) (cons '#(syntax-object list ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4558}#) - #((m4559 top)) - #("i4563")) + #(#{\ g4617}#) + #((m4618 top)) + #("i4622")) #(ribcage #(x) #((top)) - #("i4556")) + #("i4615")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4550")) + #("i4609")) #(ribcage (emit quasivector quasilist* @@ -17361,70 +17262,70 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4558\ 4564}#)) - #{tmp\ 4562}#) + #{\ g4617\ 4623}#)) + #{tmp\ 4621}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4561}#))))) - #{tmp\ 4555}#) - (let ((#{tmp\ 4567}# + #{tmp\ 4620}#))))) + #{tmp\ 4614}#) + (let ((#{tmp\ 4626}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "list*") . #(each+ any (any) ()))))) - (if #{tmp\ 4567}# + (if #{tmp\ 4626}# (@apply - (lambda (#{x\ 4570}# #{y\ 4571}#) + (lambda (#{x\ 4629}# #{y\ 4630}#) (letrec* - ((#{f\ 4574}# - (lambda (#{x*\ 4575}#) - (if (null? #{x*\ 4575}#) - (#{emit\ 4372}# #{y\ 4571}#) - (let ((#{tmp\ 4581}# - (list (#{emit\ 4372}# - (car #{x*\ 4575}#)) - (#{f\ 4574}# - (cdr #{x*\ 4575}#))))) - (let ((#{tmp\ 4582}# + ((#{f\ 4633}# + (lambda (#{x*\ 4634}#) + (if (null? #{x*\ 4634}#) + (#{emit\ 4431}# #{y\ 4630}#) + (let ((#{tmp\ 4640}# + (list (#{emit\ 4431}# + (car #{x*\ 4634}#)) + (#{f\ 4633}# + (cdr #{x*\ 4634}#))))) + (let ((#{tmp\ 4641}# ($sc-dispatch - #{tmp\ 4581}# + #{tmp\ 4640}# '(any any)))) - (if #{tmp\ 4582}# + (if #{tmp\ 4641}# (@apply - (lambda (#{\ g4578\ 4585}# - #{\ g4577\ 4586}#) + (lambda (#{\ g4637\ 4644}# + #{\ g4636\ 4645}#) (list '#(syntax-object cons ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4578}# - #{\ g4577}#) - #((m4579 top) - (m4579 top)) - #("i4583" "i4584")) + #(#{\ g4637}# + #{\ g4636}#) + #((m4638 top) + (m4638 top)) + #("i4642" "i4643")) #(ribcage () () ()) #(ribcage #(f x*) #((top) (top)) - #("i4572" "i4573")) + #("i4631" "i4632")) #(ribcage #(x y) #((top) (top)) - #("i4568" "i4569")) + #("i4627" "i4628")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4550")) + #("i4609")) #(ribcage (emit quasivector quasilist* @@ -17439,56 +17340,56 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4578\ 4585}# - #{\ g4577\ 4586}#)) - #{tmp\ 4582}#) + #{\ g4637\ 4644}# + #{\ g4636\ 4645}#)) + #{tmp\ 4641}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4581}#)))))))) - (begin (#{f\ 4574}# #{x\ 4570}#)))) - #{tmp\ 4567}#) - (let ((#{tmp\ 4587}# + #{tmp\ 4640}#)))))))) + (begin (#{f\ 4633}# #{x\ 4629}#)))) + #{tmp\ 4626}#) + (let ((#{tmp\ 4646}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "append") . each-any)))) - (if #{tmp\ 4587}# + (if #{tmp\ 4646}# (@apply - (lambda (#{x\ 4589}#) - (let ((#{tmp\ 4593}# - (map #{emit\ 4372}# #{x\ 4589}#))) - (let ((#{tmp\ 4594}# + (lambda (#{x\ 4648}#) + (let ((#{tmp\ 4652}# + (map #{emit\ 4431}# #{x\ 4648}#))) + (let ((#{tmp\ 4653}# ($sc-dispatch - #{tmp\ 4593}# + #{tmp\ 4652}# 'each-any))) - (if #{tmp\ 4594}# + (if #{tmp\ 4653}# (@apply - (lambda (#{\ g4590\ 4596}#) + (lambda (#{\ g4649\ 4655}#) (cons '#(syntax-object append ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4590}#) - #((m4591 top)) - #("i4595")) + #(#{\ g4649}#) + #((m4650 top)) + #("i4654")) #(ribcage #(x) #((top)) - #("i4588")) + #("i4647")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4550")) + #("i4609")) #(ribcage (emit quasivector quasilist* @@ -17503,54 +17404,54 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4590\ 4596}#)) - #{tmp\ 4594}#) + #{\ g4649\ 4655}#)) + #{tmp\ 4653}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4593}#))))) - #{tmp\ 4587}#) - (let ((#{tmp\ 4599}# + #{tmp\ 4652}#))))) + #{tmp\ 4646}#) + (let ((#{tmp\ 4658}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "vector") . each-any)))) - (if #{tmp\ 4599}# + (if #{tmp\ 4658}# (@apply - (lambda (#{x\ 4601}#) - (let ((#{tmp\ 4605}# - (map #{emit\ 4372}# #{x\ 4601}#))) - (let ((#{tmp\ 4606}# + (lambda (#{x\ 4660}#) + (let ((#{tmp\ 4664}# + (map #{emit\ 4431}# #{x\ 4660}#))) + (let ((#{tmp\ 4665}# ($sc-dispatch - #{tmp\ 4605}# + #{tmp\ 4664}# 'each-any))) - (if #{tmp\ 4606}# + (if #{tmp\ 4665}# (@apply - (lambda (#{\ g4602\ 4608}#) + (lambda (#{\ g4661\ 4667}#) (cons '#(syntax-object vector ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4602}#) - #((m4603 top)) - #("i4607")) + #(#{\ g4661}#) + #((m4662 top)) + #("i4666")) #(ribcage #(x) #((top)) - #("i4600")) + #("i4659")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4550")) + #("i4609")) #(ribcage (emit quasivector quasilist* @@ -17565,49 +17466,49 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4602\ 4608}#)) - #{tmp\ 4606}#) + #{\ g4661\ 4667}#)) + #{tmp\ 4665}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4605}#))))) - #{tmp\ 4599}#) - (let ((#{tmp\ 4611}# + #{tmp\ 4664}#))))) + #{tmp\ 4658}#) + (let ((#{tmp\ 4670}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "list->vector") any)))) - (if #{tmp\ 4611}# + (if #{tmp\ 4670}# (@apply - (lambda (#{x\ 4613}#) - (let ((#{tmp\ 4617}# - (#{emit\ 4372}# #{x\ 4613}#))) - (let ((#{\ g4614\ 4619}# - #{tmp\ 4617}#)) + (lambda (#{x\ 4672}#) + (let ((#{tmp\ 4676}# + (#{emit\ 4431}# #{x\ 4672}#))) + (let ((#{\ g4673\ 4678}# + #{tmp\ 4676}#)) (list '#(syntax-object list->vector ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4614}#) - #((m4615 top)) - #("i4618")) + #(#{\ g4673}#) + #((m4674 top)) + #("i4677")) #(ribcage #(x) #((top)) - #("i4612")) + #("i4671")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4550")) + #("i4609")) #(ribcage (emit quasivector quasilist* @@ -17622,83 +17523,83 @@ (top) (top) (top)) - ("i4371" - "i4369" - "i4367" - "i4365" - "i4363" - "i4361" - "i4359"))) + ("i4430" + "i4428" + "i4426" + "i4424" + "i4422" + "i4420" + "i4418"))) (hygiene guile)) - #{\ g4614\ 4619}#)))) - #{tmp\ 4611}#) - (let ((#{tmp\ 4620}# + #{\ g4673\ 4678}#)))) + #{tmp\ 4670}#) + (let ((#{tmp\ 4679}# ($sc-dispatch - #{tmp\ 4551}# + #{tmp\ 4610}# '(#(atom "value") any)))) - (if #{tmp\ 4620}# + (if #{tmp\ 4679}# (@apply - (lambda (#{x\ 4622}#) #{x\ 4622}#) - #{tmp\ 4620}#) + (lambda (#{x\ 4681}#) #{x\ 4681}#) + #{tmp\ 4679}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4551}#))))))))))))))))))) + #{tmp\ 4610}#))))))))))))))))))) (begin - (lambda (#{x\ 4623}#) - (let ((#{tmp\ 4625}# #{x\ 4623}#)) - (let ((#{tmp\ 4626}# - ($sc-dispatch #{tmp\ 4625}# '(_ any)))) - (if #{tmp\ 4626}# + (lambda (#{x\ 4682}#) + (let ((#{tmp\ 4684}# #{x\ 4682}#)) + (let ((#{tmp\ 4685}# + ($sc-dispatch #{tmp\ 4684}# '(_ any)))) + (if #{tmp\ 4685}# (@apply - (lambda (#{e\ 4628}#) - (#{emit\ 4372}# (#{quasi\ 4360}# #{e\ 4628}# 0))) - #{tmp\ 4626}#) + (lambda (#{e\ 4687}#) + (#{emit\ 4431}# (#{quasi\ 4419}# #{e\ 4687}# 0))) + #{tmp\ 4685}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4625}#))))))))) + #{tmp\ 4684}#))))))))) (define include (make-syntax-transformer 'include 'macro - (lambda (#{x\ 4629}#) + (lambda (#{x\ 4688}#) (letrec* - ((#{read-file\ 4632}# - (lambda (#{fn\ 4633}# #{k\ 4634}#) + ((#{read-file\ 4691}# + (lambda (#{fn\ 4692}# #{k\ 4693}#) (begin - (let ((#{p\ 4638}# (open-input-file #{fn\ 4633}#))) + (let ((#{p\ 4697}# (open-input-file #{fn\ 4692}#))) (letrec* - ((#{f\ 4642}# - (lambda (#{x\ 4643}# #{result\ 4644}#) - (if (eof-object? #{x\ 4643}#) + ((#{f\ 4701}# + (lambda (#{x\ 4702}# #{result\ 4703}#) + (if (eof-object? #{x\ 4702}#) (begin - (close-input-port #{p\ 4638}#) - (reverse #{result\ 4644}#)) - (#{f\ 4642}# - (read #{p\ 4638}#) - (cons (datum->syntax #{k\ 4634}# #{x\ 4643}#) - #{result\ 4644}#)))))) - (begin (#{f\ 4642}# (read #{p\ 4638}#) '())))))))) + (close-input-port #{p\ 4697}#) + (reverse #{result\ 4703}#)) + (#{f\ 4701}# + (read #{p\ 4697}#) + (cons (datum->syntax #{k\ 4693}# #{x\ 4702}#) + #{result\ 4703}#)))))) + (begin (#{f\ 4701}# (read #{p\ 4697}#) '())))))))) (begin - (let ((#{tmp\ 4645}# #{x\ 4629}#)) - (let ((#{tmp\ 4646}# - ($sc-dispatch #{tmp\ 4645}# '(any any)))) - (if #{tmp\ 4646}# + (let ((#{tmp\ 4704}# #{x\ 4688}#)) + (let ((#{tmp\ 4705}# + ($sc-dispatch #{tmp\ 4704}# '(any any)))) + (if #{tmp\ 4705}# (@apply - (lambda (#{k\ 4649}# #{filename\ 4650}#) + (lambda (#{k\ 4708}# #{filename\ 4709}#) (begin - (let ((#{fn\ 4652}# (syntax->datum #{filename\ 4650}#))) - (let ((#{tmp\ 4654}# - (#{read-file\ 4632}# - #{fn\ 4652}# - #{filename\ 4650}#))) - (let ((#{tmp\ 4655}# - ($sc-dispatch #{tmp\ 4654}# 'each-any))) - (if #{tmp\ 4655}# + (let ((#{fn\ 4711}# (syntax->datum #{filename\ 4709}#))) + (let ((#{tmp\ 4713}# + (#{read-file\ 4691}# + #{fn\ 4711}# + #{filename\ 4709}#))) + (let ((#{tmp\ 4714}# + ($sc-dispatch #{tmp\ 4713}# 'each-any))) + (if #{tmp\ 4714}# (@apply - (lambda (#{exp\ 4657}#) + (lambda (#{exp\ 4716}#) (cons '#(syntax-object begin ((top) @@ -17706,129 +17607,129 @@ #(ribcage #(exp) #((top)) - #("i4656")) + #("i4715")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) - #("i4651")) + #("i4710")) #(ribcage #(k filename) #((top) (top)) - #("i4647" "i4648")) + #("i4706" "i4707")) #(ribcage (read-file) ((top)) - ("i4631")) + ("i4690")) #(ribcage #(x) #((top)) - #("i4630"))) + #("i4689"))) (hygiene guile)) - #{exp\ 4657}#)) - #{tmp\ 4655}#) + #{exp\ 4716}#)) + #{tmp\ 4714}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4654}#))))))) - #{tmp\ 4646}#) + #{tmp\ 4713}#))))))) + #{tmp\ 4705}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4645}#))))))))) + #{tmp\ 4704}#))))))))) (define include-from-path (make-syntax-transformer 'include-from-path 'macro - (lambda (#{x\ 4659}#) - (let ((#{tmp\ 4661}# #{x\ 4659}#)) - (let ((#{tmp\ 4662}# - ($sc-dispatch #{tmp\ 4661}# '(any any)))) - (if #{tmp\ 4662}# + (lambda (#{x\ 4718}#) + (let ((#{tmp\ 4720}# #{x\ 4718}#)) + (let ((#{tmp\ 4721}# + ($sc-dispatch #{tmp\ 4720}# '(any any)))) + (if #{tmp\ 4721}# (@apply - (lambda (#{k\ 4665}# #{filename\ 4666}#) + (lambda (#{k\ 4724}# #{filename\ 4725}#) (begin - (let ((#{fn\ 4668}# (syntax->datum #{filename\ 4666}#))) - (let ((#{tmp\ 4670}# + (let ((#{fn\ 4727}# (syntax->datum #{filename\ 4725}#))) + (let ((#{tmp\ 4729}# (datum->syntax - #{filename\ 4666}# + #{filename\ 4725}# (begin - (let ((#{t\ 4675}# - (%search-load-path #{fn\ 4668}#))) - (if #{t\ 4675}# - #{t\ 4675}# + (let ((#{t\ 4734}# + (%search-load-path #{fn\ 4727}#))) + (if #{t\ 4734}# + #{t\ 4734}# (syntax-violation 'include-from-path "file not found in path" - #{x\ 4659}# - #{filename\ 4666}#))))))) - (let ((#{fn\ 4672}# #{tmp\ 4670}#)) + #{x\ 4718}# + #{filename\ 4725}#))))))) + (let ((#{fn\ 4731}# #{tmp\ 4729}#)) (list '#(syntax-object include ((top) #(ribcage () () ()) - #(ribcage #(fn) #((top)) #("i4671")) + #(ribcage #(fn) #((top)) #("i4730")) #(ribcage () () ()) #(ribcage () () ()) - #(ribcage #(fn) #((top)) #("i4667")) + #(ribcage #(fn) #((top)) #("i4726")) #(ribcage #(k filename) #((top) (top)) - #("i4663" "i4664")) + #("i4722" "i4723")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4660"))) + #(ribcage #(x) #((top)) #("i4719"))) (hygiene guile)) - #{fn\ 4672}#)))))) - #{tmp\ 4662}#) + #{fn\ 4731}#)))))) + #{tmp\ 4721}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4661}#))))))) + #{tmp\ 4720}#))))))) (define unquote (make-syntax-transformer 'unquote 'macro - (lambda (#{x\ 4677}#) + (lambda (#{x\ 4736}#) (syntax-violation 'unquote "expression not valid outside of quasiquote" - #{x\ 4677}#)))) + #{x\ 4736}#)))) (define unquote-splicing (make-syntax-transformer 'unquote-splicing 'macro - (lambda (#{x\ 4679}#) + (lambda (#{x\ 4738}#) (syntax-violation 'unquote-splicing "expression not valid outside of quasiquote" - #{x\ 4679}#)))) + #{x\ 4738}#)))) (define case (make-syntax-transformer 'case 'macro - (lambda (#{x\ 4681}#) - (let ((#{tmp\ 4683}# #{x\ 4681}#)) - (let ((#{tmp\ 4684}# + (lambda (#{x\ 4740}#) + (let ((#{tmp\ 4742}# #{x\ 4740}#)) + (let ((#{tmp\ 4743}# ($sc-dispatch - #{tmp\ 4683}# + #{tmp\ 4742}# '(_ any any . each-any)))) - (if #{tmp\ 4684}# + (if #{tmp\ 4743}# (@apply - (lambda (#{e\ 4688}# #{m1\ 4689}# #{m2\ 4690}#) - (let ((#{tmp\ 4692}# + (lambda (#{e\ 4747}# #{m1\ 4748}# #{m2\ 4749}#) + (let ((#{tmp\ 4751}# (letrec* - ((#{f\ 4698}# - (lambda (#{clause\ 4699}# #{clauses\ 4700}#) - (if (null? #{clauses\ 4700}#) - (let ((#{tmp\ 4702}# #{clause\ 4699}#)) - (let ((#{tmp\ 4703}# + ((#{f\ 4757}# + (lambda (#{clause\ 4758}# #{clauses\ 4759}#) + (if (null? #{clauses\ 4759}#) + (let ((#{tmp\ 4761}# #{clause\ 4758}#)) + (let ((#{tmp\ 4762}# ($sc-dispatch - #{tmp\ 4702}# + #{tmp\ 4761}# '(#(free-id #(syntax-object else @@ -17837,92 +17738,92 @@ #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile))) any . each-any)))) - (if #{tmp\ 4703}# + (if #{tmp\ 4762}# (@apply - (lambda (#{e1\ 4706}# #{e2\ 4707}#) + (lambda (#{e1\ 4765}# #{e2\ 4766}#) (cons '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) - #("i4704" "i4705")) + #("i4763" "i4764")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) - (cons #{e1\ 4706}# - #{e2\ 4707}#))) - #{tmp\ 4703}#) - (let ((#{tmp\ 4709}# + (cons #{e1\ 4765}# + #{e2\ 4766}#))) + #{tmp\ 4762}#) + (let ((#{tmp\ 4768}# ($sc-dispatch - #{tmp\ 4702}# + #{tmp\ 4761}# '(each-any any . each-any)))) - (if #{tmp\ 4709}# + (if #{tmp\ 4768}# (@apply - (lambda (#{k\ 4713}# - #{e1\ 4714}# - #{e2\ 4715}#) + (lambda (#{k\ 4772}# + #{e1\ 4773}# + #{e2\ 4774}#) (list '#(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) - #("i4710" - "i4711" - "i4712")) + #("i4769" + "i4770" + "i4771")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) (list '#(syntax-object memv @@ -17932,9 +17833,9 @@ #((top) (top) (top)) - #("i4710" - "i4711" - "i4712")) + #("i4769" + "i4770" + "i4771")) #(ribcage () () @@ -17946,17 +17847,17 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -17964,7 +17865,7 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) '#(syntax-object t @@ -17974,9 +17875,9 @@ #((top) (top) (top)) - #("i4710" - "i4711" - "i4712")) + #("i4769" + "i4770" + "i4771")) #(ribcage () () @@ -17988,17 +17889,17 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18006,7 +17907,7 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) (list '#(syntax-object quote @@ -18018,9 +17919,9 @@ #((top) (top) (top)) - #("i4710" - "i4711" - "i4712")) + #("i4769" + "i4770" + "i4771")) #(ribcage () () @@ -18032,9 +17933,9 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 @@ -18042,9 +17943,9 @@ #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18052,10 +17953,10 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) - #{k\ 4713}#)) + #{k\ 4772}#)) (cons '#(syntax-object begin ((top) @@ -18064,9 +17965,9 @@ #((top) (top) (top)) - #("i4710" - "i4711" - "i4712")) + #("i4769" + "i4770" + "i4771")) #(ribcage () () @@ -18078,17 +17979,17 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18096,64 +17997,64 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) - (cons #{e1\ 4714}# - #{e2\ 4715}#)))) - #{tmp\ 4709}#) - (let ((#{_\ 4719}# #{tmp\ 4702}#)) + (cons #{e1\ 4773}# + #{e2\ 4774}#)))) + #{tmp\ 4768}#) + (let ((#{_\ 4778}# #{tmp\ 4761}#)) (syntax-violation 'case "bad clause" - #{x\ 4681}# - #{clause\ 4699}#))))))) - (let ((#{tmp\ 4721}# - (#{f\ 4698}# - (car #{clauses\ 4700}#) - (cdr #{clauses\ 4700}#)))) - (let ((#{rest\ 4723}# #{tmp\ 4721}#)) - (let ((#{tmp\ 4724}# #{clause\ 4699}#)) - (let ((#{tmp\ 4725}# + #{x\ 4740}# + #{clause\ 4758}#))))))) + (let ((#{tmp\ 4780}# + (#{f\ 4757}# + (car #{clauses\ 4759}#) + (cdr #{clauses\ 4759}#)))) + (let ((#{rest\ 4782}# #{tmp\ 4780}#)) + (let ((#{tmp\ 4783}# #{clause\ 4758}#)) + (let ((#{tmp\ 4784}# ($sc-dispatch - #{tmp\ 4724}# + #{tmp\ 4783}# '(each-any any . each-any)))) - (if #{tmp\ 4725}# + (if #{tmp\ 4784}# (@apply - (lambda (#{k\ 4729}# - #{e1\ 4730}# - #{e2\ 4731}#) + (lambda (#{k\ 4788}# + #{e1\ 4789}# + #{e2\ 4790}#) (list '#(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) - #("i4726" - "i4727" - "i4728")) + #("i4785" + "i4786" + "i4787")) #(ribcage () () ()) #(ribcage #(rest) #((top)) - #("i4722")) + #("i4781")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) (list '#(syntax-object memv @@ -18163,9 +18064,9 @@ #((top) (top) (top)) - #("i4726" - "i4727" - "i4728")) + #("i4785" + "i4786" + "i4787")) #(ribcage () () @@ -18173,7 +18074,7 @@ #(ribcage #(rest) #((top)) - #("i4722")) + #("i4781")) #(ribcage () () @@ -18185,17 +18086,17 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18203,7 +18104,7 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) '#(syntax-object t @@ -18213,9 +18114,9 @@ #((top) (top) (top)) - #("i4726" - "i4727" - "i4728")) + #("i4785" + "i4786" + "i4787")) #(ribcage () () @@ -18223,7 +18124,7 @@ #(ribcage #(rest) #((top)) - #("i4722")) + #("i4781")) #(ribcage () () @@ -18235,17 +18136,17 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18253,7 +18154,7 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) (list '#(syntax-object quote @@ -18265,9 +18166,9 @@ #((top) (top) (top)) - #("i4726" - "i4727" - "i4728")) + #("i4785" + "i4786" + "i4787")) #(ribcage () () @@ -18275,7 +18176,7 @@ #(ribcage #(rest) #((top)) - #("i4722")) + #("i4781")) #(ribcage () () @@ -18287,9 +18188,9 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 @@ -18297,9 +18198,9 @@ #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18307,10 +18208,10 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) - #{k\ 4729}#)) + #{k\ 4788}#)) (cons '#(syntax-object begin ((top) @@ -18319,9 +18220,9 @@ #((top) (top) (top)) - #("i4726" - "i4727" - "i4728")) + #("i4785" + "i4786" + "i4787")) #(ribcage () () @@ -18329,7 +18230,7 @@ #(ribcage #(rest) #((top)) - #("i4722")) + #("i4781")) #(ribcage () () @@ -18341,17 +18242,17 @@ #((top) (top) (top)) - #("i4695" - "i4696" - "i4697")) + #("i4754" + "i4755" + "i4756")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" - "i4686" - "i4687")) + #("i4744" + "i4745" + "i4746")) #(ribcage () () @@ -18359,31 +18260,31 @@ #(ribcage #(x) #((top)) - #("i4682"))) + #("i4741"))) (hygiene guile)) - (cons #{e1\ 4730}# - #{e2\ 4731}#)) - #{rest\ 4723}#)) - #{tmp\ 4725}#) - (let ((#{_\ 4735}# #{tmp\ 4724}#)) + (cons #{e1\ 4789}# + #{e2\ 4790}#)) + #{rest\ 4782}#)) + #{tmp\ 4784}#) + (let ((#{_\ 4794}# #{tmp\ 4783}#)) (syntax-violation 'case "bad clause" - #{x\ 4681}# - #{clause\ 4699}#))))))))))) - (begin (#{f\ 4698}# #{m1\ 4689}# #{m2\ 4690}#))))) - (let ((#{body\ 4694}# #{tmp\ 4692}#)) + #{x\ 4740}# + #{clause\ 4758}#))))))))))) + (begin (#{f\ 4757}# #{m1\ 4748}# #{m2\ 4749}#))))) + (let ((#{body\ 4753}# #{tmp\ 4751}#)) (list '#(syntax-object let ((top) #(ribcage () () ()) - #(ribcage #(body) #((top)) #("i4693")) + #(ribcage #(body) #((top)) #("i4752")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" "i4686" "i4687")) + #("i4744" "i4745" "i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4682"))) + #(ribcage #(x) #((top)) #("i4741"))) (hygiene guile)) (list (list '#(syntax-object t @@ -18392,177 +18293,177 @@ #(ribcage #(body) #((top)) - #("i4693")) + #("i4752")) #(ribcage #(e m1 m2) #((top) (top) (top)) - #("i4685" "i4686" "i4687")) + #("i4744" "i4745" "i4746")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4682"))) + #(ribcage #(x) #((top)) #("i4741"))) (hygiene guile)) - #{e\ 4688}#)) - #{body\ 4694}#)))) - #{tmp\ 4684}#) + #{e\ 4747}#)) + #{body\ 4753}#)))) + #{tmp\ 4743}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4683}#))))))) + #{tmp\ 4742}#))))))) (define make-variable-transformer - (lambda (#{proc\ 4736}#) - (if (procedure? #{proc\ 4736}#) + (lambda (#{proc\ 4795}#) + (if (procedure? #{proc\ 4795}#) (begin (letrec* - ((#{trans\ 4739}# - (lambda (#{x\ 4740}#) - (#{proc\ 4736}# #{x\ 4740}#)))) + ((#{trans\ 4798}# + (lambda (#{x\ 4799}#) + (#{proc\ 4795}# #{x\ 4799}#)))) (begin (set-procedure-property! - #{trans\ 4739}# + #{trans\ 4798}# 'variable-transformer #t) - #{trans\ 4739}#))) + #{trans\ 4798}#))) (error "variable transformer not a procedure" - #{proc\ 4736}#)))) + #{proc\ 4795}#)))) (define identifier-syntax (make-syntax-transformer 'identifier-syntax 'macro - (lambda (#{x\ 4742}#) - (let ((#{tmp\ 4744}# #{x\ 4742}#)) - (let ((#{tmp\ 4745}# - ($sc-dispatch #{tmp\ 4744}# '(_ any)))) - (if #{tmp\ 4745}# + (lambda (#{x\ 4801}#) + (let ((#{tmp\ 4803}# #{x\ 4801}#)) + (let ((#{tmp\ 4804}# + ($sc-dispatch #{tmp\ 4803}# '(_ any)))) + (if #{tmp\ 4804}# (@apply - (lambda (#{e\ 4747}#) + (lambda (#{e\ 4806}#) (list '#(syntax-object lambda ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '(#(syntax-object x ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile))) '#((#(syntax-object macro-type ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) . #(syntax-object identifier-syntax ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)))) (list '#(syntax-object syntax-case ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '#(syntax-object x ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '() (list '#(syntax-object id ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '(#(syntax-object identifier? ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) (#(syntax-object syntax ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) #(syntax-object id ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)))) (list '#(syntax-object syntax ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - #{e\ 4747}#)) + #{e\ 4806}#)) (list '(#(syntax-object _ ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) #(syntax-object x ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) #(syntax-object ... ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile))) (list '#(syntax-object syntax ((top) - #(ribcage #(e) #((top)) #("i4746")) + #(ribcage #(e) #((top)) #("i4805")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - (cons #{e\ 4747}# + (cons #{e\ 4806}# '(#(syntax-object x ((top) #(ribcage #(e) #((top)) - #("i4746")) + #("i4805")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) #(syntax-object ... @@ -18570,55 +18471,55 @@ #(ribcage #(e) #((top)) - #("i4746")) + #("i4805")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile))))))))) - #{tmp\ 4745}#) - (let ((#{tmp\ 4748}# + #{tmp\ 4804}#) + (let ((#{tmp\ 4807}# ($sc-dispatch - #{tmp\ 4744}# + #{tmp\ 4803}# '(_ (any any) ((#(free-id #(syntax-object set! ((top) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile))) any any) any))))) - (if (if #{tmp\ 4748}# + (if (if #{tmp\ 4807}# (@apply - (lambda (#{id\ 4754}# - #{exp1\ 4755}# - #{var\ 4756}# - #{val\ 4757}# - #{exp2\ 4758}#) - (if (identifier? #{id\ 4754}#) - (identifier? #{var\ 4756}#) + (lambda (#{id\ 4813}# + #{exp1\ 4814}# + #{var\ 4815}# + #{val\ 4816}# + #{exp2\ 4817}#) + (if (identifier? #{id\ 4813}#) + (identifier? #{var\ 4815}#) #f)) - #{tmp\ 4748}#) + #{tmp\ 4807}#) #f) (@apply - (lambda (#{id\ 4766}# - #{exp1\ 4767}# - #{var\ 4768}# - #{val\ 4769}# - #{exp2\ 4770}#) + (lambda (#{id\ 4825}# + #{exp1\ 4826}# + #{var\ 4827}# + #{val\ 4828}# + #{exp2\ 4829}#) (list '#(syntax-object make-variable-transformer ((top) #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" "i4762" "i4763" "i4764" "i4765")) + #("i4820" "i4821" "i4822" "i4823" "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) (list '#(syntax-object lambda @@ -18626,13 +18527,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '(#(syntax-object x @@ -18640,13 +18541,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile))) '#((#(syntax-object macro-type @@ -18654,13 +18555,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) . #(syntax-object @@ -18669,13 +18570,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)))) (list '#(syntax-object syntax-case @@ -18683,13 +18584,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '#(syntax-object x @@ -18697,13 +18598,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile)) '(#(syntax-object set! @@ -18711,13 +18612,13 @@ #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4743"))) + #(ribcage #(x) #((top)) #("i4802"))) (hygiene guile))) (list (list '#(syntax-object set! @@ -18729,19 +18630,19 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - #{var\ 4768}# - #{val\ 4769}#) + #{var\ 4827}# + #{val\ 4828}#) (list '#(syntax-object syntax ((top) @@ -18752,19 +18653,19 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - #{exp2\ 4770}#)) - (list (cons #{id\ 4766}# + #{exp2\ 4829}#)) + (list (cons #{id\ 4825}# '(#(syntax-object x ((top) @@ -18779,16 +18680,16 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) #(syntax-object ... @@ -18804,16 +18705,16 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)))) (list '#(syntax-object syntax @@ -18825,18 +18726,18 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - (cons #{exp1\ 4767}# + (cons #{exp1\ 4826}# '(#(syntax-object x ((top) @@ -18851,11 +18752,11 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () @@ -18863,7 +18764,7 @@ #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) #(syntax-object ... @@ -18879,11 +18780,11 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () @@ -18891,10 +18792,10 @@ #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)))))) - (list #{id\ 4766}# + (list #{id\ 4825}# (list '#(syntax-object identifier? ((top) @@ -18905,16 +18806,16 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) (list '#(syntax-object syntax @@ -18930,18 +18831,18 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - #{id\ 4766}#)) + #{id\ 4825}#)) (list '#(syntax-object syntax ((top) @@ -18952,69 +18853,69 @@ (top) (top) (top)) - #("i4761" - "i4762" - "i4763" - "i4764" - "i4765")) + #("i4820" + "i4821" + "i4822" + "i4823" + "i4824")) #(ribcage () () ()) #(ribcage #(x) #((top)) - #("i4743"))) + #("i4802"))) (hygiene guile)) - #{exp1\ 4767}#)))))) - #{tmp\ 4748}#) + #{exp1\ 4826}#)))))) + #{tmp\ 4807}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4744}#))))))))) + #{tmp\ 4803}#))))))))) (define define* (make-syntax-transformer 'define* 'macro - (lambda (#{x\ 4771}#) - (let ((#{tmp\ 4773}# #{x\ 4771}#)) - (let ((#{tmp\ 4774}# + (lambda (#{x\ 4830}#) + (let ((#{tmp\ 4832}# #{x\ 4830}#)) + (let ((#{tmp\ 4833}# ($sc-dispatch - #{tmp\ 4773}# + #{tmp\ 4832}# '(_ (any . any) any . each-any)))) - (if #{tmp\ 4774}# + (if #{tmp\ 4833}# (@apply - (lambda (#{id\ 4779}# - #{args\ 4780}# - #{b0\ 4781}# - #{b1\ 4782}#) + (lambda (#{id\ 4838}# + #{args\ 4839}# + #{b0\ 4840}# + #{b1\ 4841}#) (list '#(syntax-object define ((top) #(ribcage #(id args b0 b1) #((top) (top) (top) (top)) - #("i4775" "i4776" "i4777" "i4778")) + #("i4834" "i4835" "i4836" "i4837")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4772"))) + #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)) - #{id\ 4779}# + #{id\ 4838}# (cons '#(syntax-object lambda* ((top) #(ribcage #(id args b0 b1) #((top) (top) (top) (top)) - #("i4775" "i4776" "i4777" "i4778")) + #("i4834" "i4835" "i4836" "i4837")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4772"))) + #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)) - (cons #{args\ 4780}# - (cons #{b0\ 4781}# #{b1\ 4782}#))))) - #{tmp\ 4774}#) - (let ((#{tmp\ 4784}# - ($sc-dispatch #{tmp\ 4773}# '(_ any any)))) - (if (if #{tmp\ 4784}# + (cons #{args\ 4839}# + (cons #{b0\ 4840}# #{b1\ 4841}#))))) + #{tmp\ 4833}#) + (let ((#{tmp\ 4843}# + ($sc-dispatch #{tmp\ 4832}# '(_ any any)))) + (if (if #{tmp\ 4843}# (@apply - (lambda (#{id\ 4787}# #{val\ 4788}#) + (lambda (#{id\ 4846}# #{val\ 4847}#) (identifier? '#(syntax-object x @@ -19022,29 +18923,29 @@ #(ribcage #(id val) #((top) (top)) - #("i4785" "i4786")) + #("i4844" "i4845")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4772"))) + #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)))) - #{tmp\ 4784}#) + #{tmp\ 4843}#) #f) (@apply - (lambda (#{id\ 4791}# #{val\ 4792}#) + (lambda (#{id\ 4850}# #{val\ 4851}#) (list '#(syntax-object define ((top) #(ribcage #(id val) #((top) (top)) - #("i4789" "i4790")) + #("i4848" "i4849")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("i4772"))) + #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)) - #{id\ 4791}# - #{val\ 4792}#)) - #{tmp\ 4784}#) + #{id\ 4850}# + #{val\ 4851}#)) + #{tmp\ 4843}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4773}#))))))))) + #{tmp\ 4832}#))))))))) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 426640095..17acf3ff9 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -278,10 +278,10 @@ ;; hooks to nonportable run-time helpers (begin - (define fx+ +) - (define fx- -) - (define fx= =) - (define fx< <) + (define-syntax fx+ (identifier-syntax +)) + (define-syntax fx- (identifier-syntax -)) + (define-syntax fx= (identifier-syntax =)) + (define-syntax fx< (identifier-syntax <)) (define top-level-eval-hook (lambda (x mod) From 8a12aeb9193a498c0b85c2de4d2ee1543ccb720d Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Mar 2011 14:46:21 +0200 Subject: [PATCH 155/183] fix problems detecting coding: in block comments * libguile/read.c (scm_i_scan_for_encoding): Fix for coding on first line #! and for !# immediately following the coding. * test-suite/Makefile.am: * test-suite/tests/coding.test: Add tests. --- libguile/read.c | 26 +++++---- test-suite/Makefile.am | 1 + test-suite/tests/coding.test | 104 +++++++++++++++++++++++++++++++++++ 3 files changed, 120 insertions(+), 11 deletions(-) create mode 100644 test-suite/tests/coding.test diff --git a/libguile/read.c b/libguile/read.c index e0f3cf815..5be3bd99d 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1746,22 +1746,26 @@ scm_i_scan_for_encoding (SCM port) pos = encoding_start; while (pos >= header) { - if (*pos == '\n') - { - /* This wasn't in a semicolon comment. Check for a - hash-bang comment. */ - char *beg = strstr (header, "#!"); - char *end = strstr (header, "!#"); - if (beg < encoding_start && encoding_start + encoding_length < end) - in_comment = 1; - break; - } if (*pos == ';') { in_comment = 1; break; } - pos --; + else if (*pos == '\n' || pos == header) + { + /* This wasn't in a semicolon comment. Check for a + hash-bang comment. */ + char *beg = strstr (header, "#!"); + char *end = strstr (header, "!#"); + if (beg < encoding_start && encoding_start + encoding_length <= end) + in_comment = 1; + break; + } + else + { + pos --; + continue; + } } if (!in_comment) /* This wasn't in a comment */ diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 9273406e6..8ee570b32 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -34,6 +34,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/bytevectors.test \ tests/c-api.test \ tests/chars.test \ + tests/coding.test \ tests/common-list.test \ tests/control.test \ tests/continuations.test \ diff --git a/test-suite/tests/coding.test b/test-suite/tests/coding.test new file mode 100644 index 000000000..4152af86a --- /dev/null +++ b/test-suite/tests/coding.test @@ -0,0 +1,104 @@ +;;;; coding.test --- test suite for coding declarations. -*- mode: scheme -*- +;;;; +;;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-coding) + #:use-module (test-suite lib)) + +(define (with-temp-file proc) + (let* ((name (string-copy "/tmp/coding-test.XXXXXX")) + (port (mkstemp! name))) + (let ((res (with-throw-handler + #t + (lambda () + (proc name port)) + (lambda _ + (delete-file name))))) + (delete-file name) + res))) + +(define (scan-coding str) + (with-temp-file + (lambda (name port) + (display str port) + (close port) + ;; We don't simply seek back and rescan, because the encoding scan + ;; relies on the opportunistic filling of the input buffer, which + ;; doesn't happen after a seek. + (let* ((port (open-input-file name)) + (res (port-encoding port))) + (close-port port) + res)))) + +(with-test-prefix "block comments" + + (pass-if "first line" + (equal? (scan-coding "#! coding: iso-8859-1 !#") + "ISO-8859-1")) + + (pass-if "first line no whitespace" + (equal? (scan-coding "#!coding:iso-8859-1!#") + "ISO-8859-1")) + + (pass-if "second line" + (equal? (scan-coding "#! \n coding: iso-8859-1 !#") + "ISO-8859-1")) + + (pass-if "second line no whitespace" + (equal? (scan-coding "#!\ncoding:iso-8859-1!#") + "ISO-8859-1")) + + (pass-if "third line" + (equal? (scan-coding "#! \n coding: iso-8859-1 \n !#") + "ISO-8859-1")) + + (pass-if "third line no whitespace" + (equal? (scan-coding "#!\ncoding:iso-8859-1\n!#") + "ISO-8859-1"))) + +(with-test-prefix "line comments" + (pass-if "first line, no whitespace, no nl" + (equal? (scan-coding ";coding:iso-8859-1") + "ISO-8859-1")) + + (pass-if "first line, whitespace, no nl" + (equal? (scan-coding "; coding: iso-8859-1 ") + "ISO-8859-1")) + + (pass-if "first line, no whitespace, nl" + (equal? (scan-coding ";coding:iso-8859-1\n") + "ISO-8859-1")) + + (pass-if "first line, whitespace, nl" + (equal? (scan-coding "; coding: iso-8859-1 \n") + "ISO-8859-1")) + + (pass-if "second line, no whitespace, no nl" + (equal? (scan-coding "\n;coding:iso-8859-1") + "ISO-8859-1")) + + (pass-if "second line, whitespace, no nl" + (equal? (scan-coding "\n; coding: iso-8859-1 ") + "ISO-8859-1")) + + (pass-if "second line, no whitespace, nl" + (equal? (scan-coding "\n;coding:iso-8859-1\n") + "ISO-8859-1")) + + (pass-if "second line, whitespace, nl" + (equal? (scan-coding "\n; coding: iso-8859-1 \n") + "ISO-8859-1"))) From 2ebdf6b5551646804e3adc2fc4a9acb896210f89 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Mar 2011 16:17:35 +0200 Subject: [PATCH 156/183] web.texi: fix uri->string invocation * doc/ref/web.texi (Web Examples): Fix uri->string invocation. Thanks to Romel Sandoval for the report. --- doc/ref/web.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ref/web.texi b/doc/ref/web.texi index a72a18701..dd2e3962d 100644 --- a/doc/ref/web.texi +++ b/doc/ref/web.texi @@ -1575,7 +1575,7 @@ probably know, we'll want to return a 404 response. (define (not-found request) (values (build-response #:code 404) (string-append "Resource not found: " - (unparse-uri (request-uri request))))) + (uri->string (request-uri request))))) ;; Now paste this to let the web server keep going: ,continue From 09b7459b49f699a0ef95223bd35a0e88b8437a56 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Mar 2011 16:36:01 +0200 Subject: [PATCH 157/183] web.texi: handler return types documentation * doc/ref/web.texi (Web Server): More docs on handler return types. --- doc/ref/web.texi | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/doc/ref/web.texi b/doc/ref/web.texi index dd2e3962d..46d4cfbdd 100644 --- a/doc/ref/web.texi +++ b/doc/ref/web.texi @@ -1325,13 +1325,20 @@ If the read failed, the @code{read} hook may return #f for the client socket, request, and body. @item -A user-provided handler procedure is called, with the request -and body as its arguments. The handler should return two -values: the response, as a @code{} record from @code{(web -response)}, and the response body as a string, bytevector, or -@code{#f} if not present. We also allow the response to be simply an -alist of headers, in which case a default response object is -constructed with those headers. +A user-provided handler procedure is called, with the request and body +as its arguments. The handler should return two values: the response, +as a @code{} record from @code{(web response)}, and the +response body as bytevector, or @code{#f} if not present. + +The respose and response body are run through @code{sanitize-response}, +documented below. This allows the handler writer to take some +convenient shortcuts: for example, instead of a @code{}, the +handler can simply return an alist of headers, in which case a default +response object is constructed with those headers. Instead of a +bytevector for the body, the handler can return a string, which will be +serialized into an appropriate encoding; or it can return a procedure, +which will be called on a port to write out the data. See the +@code{sanitize-response} documentation, for more. @item The @code{write} hook is called with three arguments: the client From 987b8160f58185c50c4cf4703eb15f04f6cd9f89 Mon Sep 17 00:00:00 2001 From: Kevin Fletcher Date: Thu, 31 Mar 2011 22:16:54 +0200 Subject: [PATCH 158/183] fix gc_register_my_thread et al fallback impls * libguile/threads.c (GC_register_my_thread, GC_get_stack_base): Fix fallback impls. --- libguile/threads.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/threads.c b/libguile/threads.c index d81f4f4ef..14bda1d2f 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -97,7 +97,7 @@ struct GC_stack_base { }; static int -GC_register_my_thread (struct GC_stack_base *) +GC_register_my_thread (struct GC_stack_base *stack_base) { return GC_UNIMPLEMENTED; } @@ -153,7 +153,7 @@ get_thread_stack_base () #endif static int -GC_get_stack_base (struct GC_stack_base *) +GC_get_stack_base (struct GC_stack_base *stack_base) { stack_base->mem_base = get_thread_stack_base (); #ifdef __ia64__ From 1c8a6308c0050189a777d9384f270aea3206c2e0 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Mar 2011 23:33:00 +0200 Subject: [PATCH 159/183] fix duplicate path in uninstalled-env * meta/uninstalled-env.in: Our code that checked for paths already being in the load path was not working for the last entry in the load path. This caused the last entry to be re-added to the beginning, which also caused relative filename canonicalization to prepend "module/" to everything. Terrible. --- meta/uninstalled-env.in | 3 +++ 1 file changed, 3 insertions(+) diff --git a/meta/uninstalled-env.in b/meta/uninstalled-env.in index b3deed5ab..4faad641b 100644 --- a/meta/uninstalled-env.in +++ b/meta/uninstalled-env.in @@ -59,10 +59,12 @@ else # The ":" prevents prefix aliasing. case x"$GUILE_LOAD_PATH" in x*${top_srcdir}${d}:*) ;; + x*${top_srcdir}${d}) ;; *) GUILE_LOAD_PATH="${top_srcdir}${d}:$GUILE_LOAD_PATH" ;; esac case x"$GUILE_LOAD_PATH" in x*${top_builddir}${d}:*) ;; + x*${top_builddir}${d}) ;; *) GUILE_LOAD_PATH="${top_builddir}${d}:$GUILE_LOAD_PATH" ;; esac done @@ -79,6 +81,7 @@ else # The ":" prevents prefix aliasing. case x"$GUILE_LOAD_COMPILED_PATH" in x*${top_builddir}${d}:*) ;; + x*${top_builddir}${d}) ;; *) GUILE_LOAD_COMPILED_PATH="${top_builddir}${d}:$GUILE_LOAD_COMPILED_PATH" ;; esac done From d050ef66eceb764e0c26e535140ebed795b546fa Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 1 Apr 2011 11:05:37 +0200 Subject: [PATCH 160/183] latin1 subr and message in internal scm_{encoding,decoding}_error * libguile/strings.c (scm_encoding_error, scm_decoding_error): Use scm_from_latin1_string for the subr and message args, as these are internal functions, and we know their callers. --- libguile/strings.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/libguile/strings.c b/libguile/strings.c index cdf81410d..bf637041c 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1423,8 +1423,8 @@ scm_encoding_error (const char *subr, int err, const char *message, SCM port, SCM chr) { scm_throw (scm_encoding_error_key, - scm_list_n (scm_from_locale_string (subr), - scm_from_locale_string (message), + scm_list_n (scm_from_latin1_string (subr), + scm_from_latin1_string (message), scm_from_int (err), port, chr, SCM_UNDEFINED)); @@ -1436,8 +1436,8 @@ void scm_decoding_error (const char *subr, int err, const char *message, SCM port) { scm_throw (scm_decoding_error_key, - scm_list_n (scm_from_locale_string (subr), - scm_from_locale_string (message), + scm_list_n (scm_from_latin1_string (subr), + scm_from_latin1_string (message), scm_from_int (err), port, SCM_UNDEFINED)); From 355dd8cb4bff2821f4b4da2bd989441b882ed5de Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 1 Apr 2011 11:23:12 +0200 Subject: [PATCH 161/183] make_objcode_by_mmap uses MAP_PRIVATE, not MAP_SHARED * libguile/objcodes.c (make_objcode_by_mmap): MAP_PRIVATE, not MAP_SHARED -- we don't need to update the underlying file, nor do we need to see updates. --- libguile/objcodes.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/objcodes.c b/libguile/objcodes.c index f4e20f8f2..e91e265da 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -70,7 +70,7 @@ make_objcode_by_mmap (int fd) scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", scm_list_1 (SCM_I_MAKINUM (st.st_size))); - addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0); + addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); if (addr == MAP_FAILED) { (void) close (fd); From 13a78b0fd75a4825de0624e47911810fe8a5d150 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 1 Apr 2011 12:10:42 +0200 Subject: [PATCH 162/183] support loading objcode even if mmap(2) is unavailable * configure.ac: Check for sys/mman.h. * libguile/objcodes.c (verify_cookie): Factor cookie verification out to a helper function. (make_objcode_from_file): Rename from make_objcode_by_mmap. If mmap is unavailable, just read(2) to a bytevector. --- configure.ac | 2 +- libguile/objcodes.c | 168 ++++++++++++++++++++++++++++++-------------- 2 files changed, 118 insertions(+), 52 deletions(-) diff --git a/configure.ac b/configure.ac index 4fc25536b..2fd72a477 100644 --- a/configure.ac +++ b/configure.ac @@ -773,7 +773,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime # cuserid - on Tru64 5.1b the declaration is documented to be available # only with `_XOPEN_SOURCE' or some such. # -AC_CHECK_HEADERS([crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h]) +AC_CHECK_HEADERS([crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h sys/mman.h]) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) AC_CHECK_DECLS([sethostname, hstrerror, cuserid]) diff --git a/libguile/objcodes.c b/libguile/objcodes.c index e91e265da..448badafb 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -23,12 +23,18 @@ #include #include #include + +#ifdef HAVE_SYS_MMAN_H #include +#endif + #include #include #include #include +#include + #include "_scm.h" #include "programs.h" #include "objcodes.h" @@ -44,6 +50,52 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0); * Objcode type */ +static void +verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) +#define FUNC_NAME "make_objcode_from_file" +{ + /* The cookie ends with a version of the form M.N, where M is the + major version and N is the minor version. For this Guile to be + able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N + must be less than or equal to SCM_OBJCODE_MINOR_VERSION. Since N + is the last character, we do a strict comparison on all but the + last, then a <= on the last one. */ + if (memcmp (cookie, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1)) + { + SCM args = scm_list_1 (scm_from_latin1_stringn + (cookie, strlen (SCM_OBJCODE_COOKIE))); + if (map_fd >= 0) + { + (void) close (map_fd); +#ifdef HAVE_SYS_MMAN_H + (void) munmap (map_addr, st->st_size); +#endif + } + scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args); + } + + { + char minor_version = cookie[strlen (SCM_OBJCODE_COOKIE) - 1]; + + if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0]) + { + if (map_fd >= 0) + { + (void) close (map_fd); +#ifdef HAVE_SYS_MMAN_H + (void) munmap (map_addr, st->st_size); +#endif + } + + scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)", + scm_list_2 (scm_from_latin1_stringn (&minor_version, 1), + scm_from_latin1_string + (SCM_OBJCODE_MINOR_VERSION_STRING))); + } + } +} +#undef FUNC_NAME + /* The words in an objcode SCM object are as follows: - scm_tc7_objcode | type | flags - the struct scm_objcode C object @@ -53,77 +105,91 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0); */ static SCM -make_objcode_by_mmap (int fd) -#define FUNC_NAME "make_objcode_by_mmap" +make_objcode_from_file (int fd) +#define FUNC_NAME "make_objcode_from_file" { int ret; - char *addr; + /* The SCM_OBJCODE_COOKIE is a string literal, and thus has an extra + trailing NUL, hence the - 1. */ + char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1]; struct stat st; - SCM sret = SCM_BOOL_F; - struct scm_objcode *data; ret = fstat (fd, &st); if (ret < 0) SCM_SYSERROR; - if (st.st_size <= sizeof (struct scm_objcode) + strlen (SCM_OBJCODE_COOKIE)) + if (st.st_size <= sizeof (struct scm_objcode) + sizeof cookie) scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", scm_list_1 (SCM_I_MAKINUM (st.st_size))); - addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); - if (addr == MAP_FAILED) - { - (void) close (fd); - SCM_SYSERROR; - } - - /* The cookie ends with a version of the form M.N, where M is the - major version and N is the minor version. For this Guile to be - able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N - must be less than or equal to SCM_OBJCODE_MINOR_VERSION. Since N - is the last character, we do a strict comparison on all but the - last, then a <= on the last one. */ - if (memcmp (addr, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1)) - { - SCM args = scm_list_1 (scm_from_latin1_stringn - (addr, strlen (SCM_OBJCODE_COOKIE))); - (void) close (fd); - (void) munmap (addr, st.st_size); - scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args); - } - +#ifdef HAVE_SYS_MMAN_H { - char minor_version = addr[strlen (SCM_OBJCODE_COOKIE) - 1]; + char *addr; + struct scm_objcode *data; - if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0]) - scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)", - scm_list_2 (scm_from_latin1_stringn (&minor_version, 1), - scm_from_latin1_string - (SCM_OBJCODE_MINOR_VERSION_STRING))); + addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); + + if (addr == MAP_FAILED) + { + int errno_save = errno; + (void) close (fd); + errno = errno_save; + SCM_SYSERROR; + } + else + { + memcpy (cookie, addr, sizeof cookie); + data = (struct scm_objcode *) (addr + sizeof cookie); + } + + verify_cookie (cookie, &st, fd, addr); + + + if (data->len + data->metalen + != (st.st_size - sizeof (*data) - sizeof cookie)) + { + size_t total_len = sizeof (*data) + data->len + data->metalen; + + (void) close (fd); + (void) munmap (addr, st.st_size); + + scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)", + scm_list_2 (scm_from_size_t (st.st_size), + scm_from_size_t (total_len))); + } + + /* FIXME: we leak ourselves and the file descriptor. but then again so does + dlopen(). */ + return scm_permanent_object + (scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0), + (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)), + SCM_UNPACK (scm_from_int (fd)), 0)); } +#else + { + SCM bv = scm_c_make_bytevector (st.st_size - sizeof cookie); - data = (struct scm_objcode*)(addr + strlen (SCM_OBJCODE_COOKIE)); + if (full_read (fd, cookie, sizeof cookie) != sizeof cookie + || full_read (fd, SCM_BYTEVECTOR_CONTENTS (bv), + SCM_BYTEVECTOR_LENGTH (bv)) != SCM_BYTEVECTOR_LENGTH (bv)) + { + int errno_save = errno; + (void) close (fd); + errno = errno_save; + SCM_SYSERROR; + } - if (data->len + data->metalen != (st.st_size - sizeof (*data) - strlen (SCM_OBJCODE_COOKIE))) - { - (void) close (fd); - (void) munmap (addr, st.st_size); - scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)", - scm_list_2 (scm_from_size_t (st.st_size), - scm_from_uint32 (sizeof (*data) + data->len - + data->metalen))); - } + (void) close (fd); - sret = scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0), - (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)), - SCM_UNPACK (scm_from_int (fd)), 0); + verify_cookie (cookie, &st, -1, NULL); - /* FIXME: we leak ourselves and the file descriptor. but then again so does - dlopen(). */ - return scm_permanent_object (sret); + return scm_bytecode_to_objcode (bv); + } +#endif } #undef FUNC_NAME + SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr) #define FUNC_NAME "make-objcode-slice" @@ -233,7 +299,7 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0, free (c_file); if (fd < 0) SCM_SYSERROR; - return make_objcode_by_mmap (fd); + return make_objcode_from_file (fd); } #undef FUNC_NAME From c6b08d21947b1b33de1e8cd364553112d4015253 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 1 Apr 2011 13:31:26 +0200 Subject: [PATCH 163/183] string->pointer and pointer->string have optional encoding arg * test-suite/tests/foreign.test ("pointer<->string"): Add test cases. * libguile/foreign.c (scm_string_to_pointer, scm_pointer_to_string): Add optional encoding, and in the pointer->string case, length arguments. * libguile/foreign.h: Update prototypes of internal functions. Shouldn't affect ABI as they are internal. * doc/ref/api-foreign.texi (Void Pointers and Byte Access): Update docs. --- doc/ref/api-foreign.texi | 20 +++++---- libguile/foreign.c | 79 ++++++++++++++++++++++++++++------- libguile/foreign.h | 4 +- test-suite/tests/foreign.test | 13 +++++- 4 files changed, 90 insertions(+), 26 deletions(-) diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index b5fdd001b..2dd691675 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -626,20 +626,22 @@ Assuming @var{pointer} points to a memory region that holds a pointer, return this pointer. @end deffn -@deffn {Scheme Procedure} string->pointer string +@deffn {Scheme Procedure} string->pointer string [encoding] Return a foreign pointer to a nul-terminated copy of @var{string} in the -current locale encoding. The C string is freed when the returned -foreign pointer becomes unreachable. +given @var{encoding}, defaulting to the current locale encoding. The C +string is freed when the returned foreign pointer becomes unreachable. -This is the Scheme equivalent of @code{scm_to_locale_string}. +This is the Scheme equivalent of @code{scm_to_stringn}. @end deffn -@deffn {Scheme Procedure} pointer->string pointer -Return the string representing the C nul-terminated string -pointed to by @var{pointer}. The C string is assumed to be -in the current locale encoding. +@deffn {Scheme Procedure} pointer->string pointer [length] [encoding] +Return the string representing the C string pointed to by @var{pointer}. +If @var{length} is omitted or @code{-1}, the string is assumed to be +nul-terminated. Otherwise @var{length} is the number of bytes in memory +pointed to by @var{pointer}. The C string is assumed to be in the given +@var{encoding}, defaulting to the current locale encoding. -This is the Scheme equivalent of @code{scm_from_locale_string}. +This is the Scheme equivalent of @code{scm_from_stringn}. @end deffn @cindex wrapped pointer types diff --git a/libguile/foreign.c b/libguile/foreign.c index dbfba8770..ae9e27a8d 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -355,13 +355,13 @@ SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0, - (SCM string), +SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0, + (SCM string, SCM encoding), "Return a foreign pointer to a nul-terminated copy of\n" - "@var{string} in the current locale encoding. The C\n" - "string is freed when the returned foreign pointer\n" - "becomes unreachable.\n\n" - "This is the Scheme equivalent of @code{scm_to_locale_string}.") + "@var{string} in the given @var{encoding}, defaulting to\n" + "the current locale encoding. The C string is freed when\n" + "the returned foreign pointer becomes unreachable.\n\n" + "This is the Scheme equivalent of @code{scm_to_stringn}.") #define FUNC_NAME s_scm_string_to_pointer { SCM_VALIDATE_STRING (1, string); @@ -369,21 +369,72 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0, /* XXX: Finalizers slow down libgc; they could be avoided if `scm_to_string' & co. were able to use libgc-allocated memory. */ - return scm_from_pointer (scm_to_locale_string (string), free); + if (SCM_UNBNDP (encoding)) + return scm_from_pointer (scm_to_locale_string (string), free); + else + { + char *enc; + SCM ret; + + SCM_VALIDATE_STRING (2, encoding); + + enc = scm_to_locale_string (encoding); + scm_dynwind_begin (0); + scm_dynwind_free (enc); + + ret = scm_from_pointer + (scm_to_stringn (string, NULL, enc, + scm_i_get_conversion_strategy (SCM_BOOL_F)), + free); + + scm_dynwind_end (); + + return ret; + } } #undef FUNC_NAME -SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 0, 0, - (SCM pointer), - "Return the string representing the C nul-terminated string\n" - "pointed to by @var{pointer}. The C string is assumed to be\n" - "in the current locale encoding.\n\n" - "This is the Scheme equivalent of @code{scm_from_locale_string}.") +SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0, + (SCM pointer, SCM length, SCM encoding), + "Return the string representing the C string pointed to by\n" + "@var{pointer}. If @var{length} is omitted or @code{-1}, the\n" + "string is assumed to be nul-terminated. Otherwise\n" + "@var{length} is the number of bytes in memory pointed to by\n" + "@var{pointer}. The C string is assumed to be in the given\n" + "@var{encoding}, defaulting to the current locale encoding.\n\n" + "This is the Scheme equivalent of @code{scm_from_stringn}.") #define FUNC_NAME s_scm_pointer_to_string { + size_t len; + SCM_VALIDATE_POINTER (1, pointer); - return scm_from_locale_string (SCM_POINTER_VALUE (pointer)); + if (SCM_UNBNDP (length) + || scm_is_true (scm_eqv_p (length, scm_from_int (-1)))) + len = (size_t)-1; + else + len = scm_to_size_t (length); + + if (SCM_UNBNDP (encoding)) + return scm_from_locale_stringn (SCM_POINTER_VALUE (pointer), len); + else + { + char *enc; + SCM ret; + + SCM_VALIDATE_STRING (3, encoding); + + enc = scm_to_locale_string (encoding); + scm_dynwind_begin (0); + scm_dynwind_free (enc); + + ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc, + scm_i_get_conversion_strategy (SCM_BOOL_F)); + + scm_dynwind_end (); + + return ret; + } } #undef FUNC_NAME diff --git a/libguile/foreign.h b/libguile/foreign.h index b29001962..6c6f37306 100644 --- a/libguile/foreign.h +++ b/libguile/foreign.h @@ -72,8 +72,8 @@ SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate); SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer); -SCM_INTERNAL SCM scm_string_to_pointer (SCM string); -SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer); +SCM_INTERNAL SCM scm_string_to_pointer (SCM string, SCM encoding); +SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer, SCM length, SCM encoding); diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 1353e7dbb..60b466e1c 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -153,7 +153,18 @@ (pass-if "bijection [latin1]" (with-latin1-locale (let ((s "Szép jó napot!")) - (string=? s (pointer->string (string->pointer s))))))) + (string=? s (pointer->string (string->pointer s)))))) + + (pass-if "bijection, utf-8" + (let ((s "hello, world")) + (string=? s (pointer->string (string->pointer s "utf-8") + -1 "utf-8")))) + + (pass-if "bijection, utf-8 [latin1]" + (let ((s "Szép jó napot!")) + (string=? s (pointer->string (string->pointer s "utf-8") + -1 "utf-8"))))) + (with-test-prefix "pointer->procedure" From 39bed56f670267f66d99f98cd58978871b789557 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 1 Apr 2011 16:45:58 +0200 Subject: [PATCH 164/183] fix c32vector-set!, c64vector-set! * module/srfi/srfi-4/gnu.scm (bytevector-c32-native-set!): (bytevector-c64-native-set!): Fix to actually allow complex numbers. * test-suite/tests/srfi-4.test: Add tests. --- module/srfi/srfi-4/gnu.scm | 10 ++--- test-suite/tests/srfi-4.test | 84 +++++++++++++++++++++++++++++++++++- 2 files changed, 88 insertions(+), 6 deletions(-) diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm index 8cd5e895b..ac22809ea 100644 --- a/module/srfi/srfi-4/gnu.scm +++ b/module/srfi/srfi-4/gnu.scm @@ -1,6 +1,6 @@ ;;; Extensions to SRFI-4 -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -83,14 +83,14 @@ (make-rectangular (bytevector-ieee-single-native-ref v i) (bytevector-ieee-single-native-ref v (+ i 4)))) (define (bytevector-c32-native-set! v i x) - (bytevector-ieee-single-native-set! v i x) - (bytevector-ieee-single-native-set! v (+ i 4) x)) + (bytevector-ieee-single-native-set! v i (real-part x)) + (bytevector-ieee-single-native-set! v (+ i 4) (imag-part x))) (define (bytevector-c64-native-ref v i) (make-rectangular (bytevector-ieee-double-native-ref v i) (bytevector-ieee-double-native-ref v (+ i 8)))) (define (bytevector-c64-native-set! v i x) - (bytevector-ieee-double-native-set! v i x) - (bytevector-ieee-double-native-set! v (+ i 8) x)) + (bytevector-ieee-double-native-set! v i (real-part x)) + (bytevector-ieee-double-native-set! v (+ i 8) (imag-part x))) (define-bytevector-type c32 c32-native 8) (define-bytevector-type c64 c64-native 16) diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index 0cdfb6699..fca065d55 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -1,7 +1,7 @@ ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-06-26 ;;;; -;;;; Copyright (C) 2001, 2006, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -18,6 +18,7 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (use-modules (srfi srfi-4) + (srfi srfi-4 gnu) (test-suite lib)) (with-test-prefix "u8 vectors" @@ -396,3 +397,84 @@ (pass-if "+inf.0, -inf.0, +nan.0 in f64vector" (f64vector? #f64(+inf.0 -inf.0 +nan.0)))) + +(with-test-prefix "c32 vectors" + + (pass-if "c32vector? success" + (c32vector? (c32vector))) + + (pass-if "c32vector? failure" + (not (c32vector? (s8vector)))) + + (pass-if "c32vector-length success 1" + (= (c32vector-length (c32vector)) 0)) + + (pass-if "c32vector-length success 2" + (= (c32vector-length (c32vector -3-2i)) 1)) + + (pass-if "c32vector-length failure" + (not (= (c32vector-length (c32vector 3)) 3))) + + (pass-if "c32vector-ref" + (= (c32vector-ref (c32vector 1 2+13i 3) 1) 2+13i)) + + (pass-if "c32vector-set!/ref" + (= (let ((s (make-c32vector 10 0))) + (c32vector-set! s 4 33-1i) + (c32vector-ref s 4)) 33-1i)) + + (pass-if "c32vector->list/list->c32vector" + (equal? (c32vector->list (c32vector 1 2 3 4)) + (c32vector->list (list->c32vector '(1 2 3 4))))) + + (pass-if "c32vector->list/uniform-vector->list" + (equal? (c32vector->list (c32vector 1 2 3 4)) + (uniform-vector->list (c32vector 1 2 3 4)))) + + (pass-if "make-c32vector" + (equal? (list->c32vector '(7 7 7 7)) + (make-c32vector 4 7))) + + (pass-if "+inf.0, -inf.0, +nan.0 in c32vector" + (c32vector? #c32(+inf.0 -inf.0 +nan.0)))) + +(with-test-prefix "c64 vectors" + + (pass-if "c64vector? success" + (c64vector? (c64vector))) + + (pass-if "c64vector? failure" + (not (c64vector? (s8vector)))) + + (pass-if "c64vector-length success 1" + (= (c64vector-length (c64vector)) 0)) + + (pass-if "c64vector-length success 2" + (= (c64vector-length (c64vector -3-2i)) 1)) + + (pass-if "c64vector-length failure" + (not (= (c64vector-length (c64vector 3)) 3))) + + (pass-if "c64vector-ref" + (= (c64vector-ref (c64vector 1+2i 2+3i 3) 1) 2+3i)) + + (pass-if "c64vector-set!/ref" + (= (let ((s (make-c64vector 10 0))) + (c64vector-set! s 4 33+1i) + (c64vector-ref s 4)) 33+1i)) + + (pass-if "c64vector->list/list->c64vector" + (equal? (c64vector->list (c64vector 1 2 3 4)) + (c64vector->list (list->c64vector '(1 2 3 4))))) + + (pass-if "c64vector->list/uniform-vector->list" + (equal? (c64vector->list (c64vector 1 2 3 4)) + (uniform-vector->list (c64vector 1 2 3 4)))) + + (pass-if "make-c64vector" + (equal? (list->c64vector '(7 7 7 7)) + (make-c64vector 4 7))) + + (pass-if "+inf.0, -inf.0, +nan.0 in c64vector" + (c64vector? #c64(+inf.0 -inf.0 +nan.0)))) + From 90fed973abf1d55212d7a43f8450f5fe76d9e6a2 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 3 Apr 2011 22:03:56 +0200 Subject: [PATCH 165/183] pthread-threads.h: only redirect to GC_pthread_sigmask if it is present * configure.ac: Check for pthread_sigmask. * libguile/gen-scmconfig.c: Create SCM_HAVE_GC_PTHREAD_SIGMASK. * libguile/pthread-threads.h (scm_i_pthread_sigmask): Only redirect to GC_pthread_sigmask if GC_pthread_sigmask is present. --- configure.ac | 2 +- libguile/gen-scmconfig.c | 6 ++++++ libguile/pthread-threads.h | 4 ++++ 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 2fd72a477..45438c8a1 100644 --- a/configure.ac +++ b/configure.ac @@ -1238,7 +1238,7 @@ save_LIBS="$LIBS" LIBS="$BDW_GC_LIBS $LIBS" CFLAGS="$BDW_GC_CFLAGS $CFLAGS" -AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel GC_allow_register_threads]) +AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask]) # Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not # declared, and has a different type (returning void instead of diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index 97066b78e..5834346c7 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -330,6 +330,12 @@ main (int argc, char *argv[]) pf ("#define SCM_HAVE_GC_PTHREAD_EXIT 0 /* 0 or 1 */\n"); #endif +#ifdef HAVE_GC_PTHREAD_SIGMASK + pf ("#define SCM_HAVE_GC_PTHREAD_SIGMASK 1 /* 0 or 1 */\n"); +#else + pf ("#define SCM_HAVE_GC_PTHREAD_SIGMASK 0 /* 0 or 1 */\n"); +#endif + pf ("\n\n/*** File system access ***/\n"); pf ("/* Define to 1 if `struct dirent64' is available. */\n"); diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h index b5fff834d..4c67b1857 100644 --- a/libguile/pthread-threads.h +++ b/libguile/pthread-threads.h @@ -57,7 +57,11 @@ /* Signals */ +#if SCM_HAVE_GC_PTHREAD_SIGMASK #define scm_i_pthread_sigmask GC_pthread_sigmask +#else +#define scm_i_pthread_sigmask pthread_sigmask +#endif /* Mutexes */ From b7715701b488a1de87c7767bc437a853f10001ee Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sat, 2 Apr 2011 19:42:26 +0200 Subject: [PATCH 166/183] Add a few benchmarks for R6RS fixnum arithmetic * benchmark-suite/benchmarks/r6rs-arithmetic.bm: New file containing some benchmarks for R6RS fixnum operations. * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add benchmarks/r6rs-arithmetic. --- benchmark-suite/Makefile.am | 1 + benchmark-suite/benchmarks/r6rs-arithmetic.bm | 35 +++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 benchmark-suite/benchmarks/r6rs-arithmetic.bm diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index bac1df396..f29743f6b 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -6,6 +6,7 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \ benchmarks/if.bm \ benchmarks/logand.bm \ benchmarks/ports.bm \ + benchmarks/r6rs-arithmetic.bm \ benchmarks/read.bm \ benchmarks/srfi-1.bm \ benchmarks/srfi-13.bm \ diff --git a/benchmark-suite/benchmarks/r6rs-arithmetic.bm b/benchmark-suite/benchmarks/r6rs-arithmetic.bm new file mode 100644 index 000000000..4c9b8e6b7 --- /dev/null +++ b/benchmark-suite/benchmarks/r6rs-arithmetic.bm @@ -0,0 +1,35 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; R6RS-specific arithmetic benchmarks +;;; +;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library. If not, see +;;; . + +(define-module (benchmarks r6rs-arithmetic) + #:use-module (benchmark-suite lib) + #:use-module (rnrs arithmetic fixnums)) + + +(with-benchmark-prefix "fixnum" + + (benchmark "fixnum? [yes]" 1e7 + (fixnum? 10000)) + + (let ((n (+ most-positive-fixnum 100))) + (benchmark "fixnum? [no]" 1e7 + (fixnum? n))) + + (benchmark "fxxor [2]" 1e7 + (fxxor 3 8))) From 78d1be4aef408248bbb545d4b94b4b1335a4ab88 Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Sat, 2 Apr 2011 19:42:27 +0200 Subject: [PATCH 167/183] Several optimizations for R6RS fixnum arithmetic * module/rnrs/arithmetic/fixnums.scm (assert-fixnum): Is now a macro. (assert-fixnums): New procedure checking a the elements of a list for fixnum-ness. All callers applying `assert-fixnum' to a list now changed to use this procedure. * module/rnrs/arithmetic/fixnums.scm (define-fxop*): New for defining n-ary inlinable special-casing the binary case using `case-lambda'. All applicable procedures redefined using this macro. * module/rnrs/arithmetic/fixnums.scm: Alias all predicates to their non-fixnum counterparts. --- module/rnrs/arithmetic/fixnums.scm | 76 ++++++++++++++---------------- 1 file changed, 36 insertions(+), 40 deletions(-) diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index befbe9d35..03511edf7 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -87,6 +87,7 @@ most-negative-fixnum) (ice-9 optargs) (rnrs base (6)) + (rnrs control (6)) (rnrs arithmetic bitwise (6)) (rnrs conditions (6)) (rnrs exceptions (6)) @@ -105,50 +106,45 @@ (>= obj most-negative-fixnum) (<= obj most-positive-fixnum))) - (define (assert-fixnum . args) + (define-syntax assert-fixnum + (syntax-rules () + ((_ arg ...) + (or (and (fixnum? arg) ...) + (raise (make-assertion-violation)))))) + + (define (assert-fixnums args) (or (for-all fixnum? args) (raise (make-assertion-violation)))) - (define (fx=? fx1 fx2 . rst) - (let ((args (cons* fx1 fx2 rst))) - (apply assert-fixnum args) - (apply = args))) + (define-syntax define-fxop* + (syntax-rules () + ((_ name op) + (define name + (case-lambda + ((x y) + (assert-fixnum x y) + (op x y)) + (args + (assert-fixnums args) + (apply op args))))))) - (define (fx>? fx1 fx2 . rst) - (let ((args (cons* fx1 fx2 rst))) - (apply assert-fixnum args) - (apply > args))) + ;; All these predicates don't check their arguments for fixnum-ness, + ;; as this doesn't seem to be strictly required by R6RS. - (define (fx? >) + (define fx=? >=) + (define fx<=? <=) - (define (fx>=? fx1 fx2 . rst) - (let ((args (cons* fx1 fx2 rst))) - (apply assert-fixnum rst) - (apply >= args))) + (define fxzero? zero?) + (define fxpositive? positive?) + (define fxnegative? negative?) + (define fxodd? odd?) + (define fxeven? even?) - (define (fx<=? fx1 fx2 . rst) - (let ((args (cons* fx1 fx2 rst))) - (apply assert-fixnum rst) - (apply <= args))) - - (define (fxzero? fx) (assert-fixnum fx) (zero? fx)) - (define (fxpositive? fx) (assert-fixnum fx) (positive? fx)) - (define (fxnegative? fx) (assert-fixnum fx) (negative? fx)) - (define (fxodd? fx) (assert-fixnum fx) (odd? fx)) - (define (fxeven? fx) (assert-fixnum fx) (even? fx)) + (define-fxop* fxmax max) + (define-fxop* fxmin min) - (define (fxmax fx1 fx2 . rst) - (let ((args (cons* fx1 fx2 rst))) - (apply assert-fixnum args) - (apply max args))) - - (define (fxmin fx1 fx2 . rst) - (let ((args (cons* fx1 fx2 rst))) - (apply assert-fixnum args) - (apply min args))) - (define (fx+ fx1 fx2) (assert-fixnum fx1 fx2) (let ((r (+ fx1 fx2))) @@ -219,9 +215,9 @@ (values s0 s1))) (define (fxnot fx) (assert-fixnum fx) (lognot fx)) - (define (fxand . args) (apply assert-fixnum args) (apply logand args)) - (define (fxior . args) (apply assert-fixnum args) (apply logior args)) - (define (fxxor . args) (apply assert-fixnum args) (apply logxor args)) + (define-fxop* fxand logand) + (define-fxop* fxior logior) + (define-fxop* fxxor logxor) (define (fxif fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) From df941b5b62721d061ce5381a1a6400609e8a10b8 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 5 Apr 2011 19:42:06 -0400 Subject: [PATCH 168/183] Undeprecate read syntax for uniform complex vectors * libguile/read.c (scm_read_sharp): Move the "#c..." case outside of #if SCM_ENABLE_DEPRECATED, and to the same section which handles "#s...", "#u..." and "#f...". Thanks to Andreas Rottmann for the bug report. --- libguile/read.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/read.c b/libguile/read.c index 5be3bd99d..a05a86d40 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1329,6 +1329,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port) case 's': case 'u': case 'f': + case 'c': /* This one may return either a boolean or an SRFI-4 vector. */ return (scm_read_srfi4_vector (chr, port)); case 'v': @@ -1348,7 +1349,6 @@ scm_read_sharp (scm_t_wchar chr, SCM port) #if SCM_ENABLE_DEPRECATED /* See below for 'i' and 'e'. */ case 'a': - case 'c': case 'y': case 'h': case 'l': From ce6066065dda2cf1854f6a63324abb75dc0bc23f Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 6 Apr 2011 13:00:34 -0400 Subject: [PATCH 169/183] Doc fix: quotient/remainder/modulo do not require exact arguments * doc/ref/api-data.texi (Arithmetic): `floor-remainder' is equivalent to the R5RS `modulo' when the arguments are integers. Previously, equivalence was claimed only for exact integers. Similarly for `truncate-quotient' and `truncate-remainder' compared with the R5RS `quotient' and `remainder'. --- doc/ref/api-data.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 0c4553f0e..2b407ea99 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1308,7 +1308,7 @@ both @var{q} and @var{r}, and is more efficient than computing each separately. Note that @var{r}, if non-zero, will have the same sign as @var{y}. -When @var{x} and @var{y} are exact integers, @code{floor-remainder} is +When @var{x} and @var{y} are integers, @code{floor-remainder} is equivalent to the R5RS integer-only operator @code{modulo}. @lisp @@ -1365,7 +1365,7 @@ both @var{q} and @var{r}, and is more efficient than computing each separately. Note that @var{r}, if non-zero, will have the same sign as @var{x}. -When @var{x} and @var{y} are exact integers, these operators are +When @var{x} and @var{y} are integers, these operators are equivalent to the R5RS integer-only operators @code{quotient} and @code{remainder}. From 6ebecdeb7da37a1ff0ab1d01e2f2fec225667a74 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 6 Apr 2011 18:24:40 -0400 Subject: [PATCH 170/183] Fix parsing of exact numbers with negative exponents * libguile/numbers.c (mem2decimal_from_point): Use scm_divide instead of scm_divide2real when applying a negative exponent, to preserve exactness in case the "#e" forced exactness specifier is present. This fixes a bug where numeric literals such as "#e1e-5" yielded incorrect fractions. --- libguile/numbers.c | 2 +- test-suite/tests/numbers.test | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 427e77263..b4f224240 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -5668,7 +5668,7 @@ mem2decimal_from_point (SCM result, SCM mem, if (sign == 1) result = scm_product (result, e); else - result = scm_divide2real (result, e); + result = scm_divide (result, e); /* We've seen an exponent, thus the value is implicitly inexact. */ x = INEXACT; diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 95842941d..d94b6a14e 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1456,6 +1456,11 @@ (pass-if (string=? (number->string 35 36) "z")) (pass-if (= (num->str->num 35 36) 35)) + ;; Before Guile 2.0.1, even in the presence of a #e forced exactness + ;; specifier, negative exponents were applied inexactly and then + ;; later coerced to exact, yielding an incorrect fraction. + (pass-if (eqv? (string->number "#e1e-10") 1/10000000000)) + ;; Numeric conversion from decimal is not precise, in its current ;; implementation, so 11.333... and 1.324... can't be expected to ;; reliably come out to precise values. These tests did actually work From 165b10ddfaaa8ecc72d45a9be7d29e7537dc2379 Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Thu, 7 Apr 2011 01:12:26 +0200 Subject: [PATCH 171/183] Move `define-inlinable' into the default namespace * module/ice-9/boot-9.scm (define-inlineable): Moved here from SRFI-9. * module/srfi/srfi-9 (define-inlinable): Removed here. * doc/ref/api-procedures.texi (Inlinable Procedures): Add subsection about `define-inlinable'. --- doc/ref/api-procedures.texi | 29 ++++++++++++++++++++++++++++- module/ice-9/boot-9.scm | 36 ++++++++++++++++++++++++++++++++++++ module/srfi/srfi-9.scm | 32 -------------------------------- 3 files changed, 64 insertions(+), 33 deletions(-) diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi index 02889c45c..5c6d38024 100644 --- a/doc/ref/api-procedures.texi +++ b/doc/ref/api-procedures.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -16,6 +16,7 @@ * Higher-Order Functions:: Function that take or return functions. * Procedure Properties:: Procedure properties and meta-information. * Procedures with Setters:: Procedures with setters. +* Inlinable Procedures:: Procedures that can be inlined. @end menu @@ -797,6 +798,32 @@ Return the setter of @var{proc}, which must be either a procedure with setter or an operator struct. @end deffn +@node Inlinable Procedures +@subsection Inlinable Procedures + +You can define an @dfn{inlinable procedure} by using +@code{define-inlinable} instead of @code{define}. An inlinable +procedure behaves the same as a regular procedure, but direct calls will +result in the procedure body being inlined into the caller. + +Procedures defined with @code{define-inlinable} are @emph{always} +inlined, at all direct call sites. This eliminates function call +overhead at the expense of an increase in code size. Additionally, the +caller will not transparently use the new definition if the inline +procedure is redefined. It is not possible to trace an inlined +procedures or install a breakpoint in it (@pxref{Traps}). For these +reasons, you should not make a procedure inlinable unless it +demonstrably improves performance in a crucial way. + +In general, only small procedures should be considered for inlining, as +making large procedures inlinable will probably result in an increase in +code size. Additionally, the elimination of the call overhead rarely +matters for for large procedures. + +@deffn {Scheme Syntax} define-inlinable (name parameter ...) body ... +Define @var{name} as a procedure with parameters @var{parameter}s and +body @var{body}. +@end deffn @c Local Variables: @c TeX-master: "guile.texi" diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 33aa33382..327e3fa31 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -3496,6 +3496,42 @@ module '(ice-9 q) '(make-q q-length))}." (syntax-violation 'require-extension "Not a recognized extension type" x))))) + +;;; Defining transparently inlinable procedures +;;; + +(define-syntax define-inlinable + ;; Define a macro and a procedure such that direct calls are inlined, via + ;; the macro expansion, whereas references in non-call contexts refer to + ;; the procedure. Inspired by the `define-integrable' macro by Dybvig et al. + (lambda (x) + ;; Use a space in the prefix to avoid potential -Wunused-toplevel + ;; warning + (define prefix (string->symbol "% ")) + (define (make-procedure-name name) + (datum->syntax name + (symbol-append prefix (syntax->datum name) + '-procedure))) + + (syntax-case x () + ((_ (name formals ...) body ...) + (identifier? #'name) + (with-syntax ((proc-name (make-procedure-name #'name)) + ((args ...) (generate-temporaries #'(formals ...)))) + #`(begin + (define (proc-name formals ...) + body ...) + (define-syntax name + (lambda (x) + (syntax-case x () + ((_ args ...) + #'((lambda (formals ...) + body ...) + args ...)) + (_ + (identifier? x) + #'proc-name)))))))))) + (define using-readline? diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm index f9449a66f..ad9e95de1 100644 --- a/module/srfi/srfi-9.scm +++ b/module/srfi/srfi-9.scm @@ -64,38 +64,6 @@ (cond-expand-provide (current-module) '(srfi-9)) -(define-syntax define-inlinable - ;; Define a macro and a procedure such that direct calls are inlined, via - ;; the macro expansion, whereas references in non-call contexts refer to - ;; the procedure. Inspired by the `define-integrable' macro by Dybvig et al. - (lambda (x) - ;; Use a space in the prefix to avoid potential -Wunused-toplevel - ;; warning - (define prefix (string->symbol "% ")) - (define (make-procedure-name name) - (datum->syntax name - (symbol-append prefix (syntax->datum name) - '-procedure))) - - (syntax-case x () - ((_ (name formals ...) body ...) - (identifier? #'name) - (with-syntax ((proc-name (make-procedure-name #'name)) - ((args ...) (generate-temporaries #'(formals ...)))) - #`(begin - (define (proc-name formals ...) - body ...) - (define-syntax name - (lambda (x) - (syntax-case x () - ((_ args ...) - #'((lambda (formals ...) - body ...) - args ...)) - (_ - (identifier? x) - #'proc-name)))))))))) - (define-syntax define-record-type (lambda (x) (define (field-identifiers field-specs) From 40c2a95a72b3a831d9de319afbc9d72a0133110e Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 7 Apr 2011 02:28:01 -0400 Subject: [PATCH 172/183] Fix typo in arithmetic benchmark * benchmark-suite/benchmarks/arithmetic.bm (fixnum): Fix `-' benchmark to actually use `-' operator instead of `+' operator. --- benchmark-suite/benchmarks/arithmetic.bm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark-suite/benchmarks/arithmetic.bm b/benchmark-suite/benchmarks/arithmetic.bm index 0755c0324..c64f6c20b 100644 --- a/benchmark-suite/benchmarks/arithmetic.bm +++ b/benchmark-suite/benchmarks/arithmetic.bm @@ -58,7 +58,7 @@ (repeat (+ 2 <>) 7 100)) (benchmark "-" 1e7 - (repeat (+ 2 <>) 7 100)) + (repeat (- 2 <>) 7 100)) (benchmark "*" 1e7 (repeat (* 1 <>) 1 100)) From b1e13fb530e0f80334862e440860c054b61dbdd0 Mon Sep 17 00:00:00 2001 From: Andreas Rottmann Date: Fri, 8 Apr 2011 23:56:30 +0200 Subject: [PATCH 173/183] Implement R6RS' `fixnum?' in a smarter way * module/rnrs/arithmetic/fixnums.scm (fixnum?): Implemented using bit-twiddling, and using `define-inlinable'. --- module/rnrs/arithmetic/fixnums.scm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index 03511edf7..0ce245811 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -76,6 +76,7 @@ fxreverse-bit-field) (import (only (guile) ash cons* + define-inlinable inexact->exact logand logbit? @@ -84,7 +85,8 @@ lognot logxor most-positive-fixnum - most-negative-fixnum) + most-negative-fixnum + object-address) (ice-9 optargs) (rnrs base (6)) (rnrs control (6)) @@ -99,12 +101,9 @@ (define (greatest-fixnum) most-positive-fixnum) (define (least-fixnum) most-negative-fixnum) - - (define (fixnum? obj) - (and (integer? obj) - (exact? obj) - (>= obj most-negative-fixnum) - (<= obj most-positive-fixnum))) + + (define-inlinable (fixnum? obj) + (not (= 0 (logand 2 (object-address obj))))) (define-syntax assert-fixnum (syntax-rules () From 882c89636a2a4afa26cff17c7cdbc1d8c1cb2745 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 6 Apr 2011 15:09:42 -0400 Subject: [PATCH 174/183] Fix the R6RS exact-integer-sqrt and import into core guile * libguile/numbers.c (scm_exact_integer_sqrt): New C procedure to compute exact integer square root and remainder. (scm_i_exact_integer_sqrt): New Scheme procedure `exact-integer-sqrt' from the R6RS, imported into core guile. * libguile/numbers.h: Add prototypes. * module/rnrs/base.scm: Remove broken stub implementation, which would fail badly when applied to large integers. * doc/ref/api-data.texi: Add documentation. * doc/ref/r6rs.texi: Change documentation for `exact-integer-sqrt' to a stub that xrefs the core docs, as is done for other operations available in core. * test-suite/tests/numbers.test: Add tests. * NEWS: Add news entries. --- NEWS | 15 ++++++++ doc/ref/api-data.texi | 12 +++++++ doc/ref/r6rs.texi | 6 +--- libguile/numbers.c | 64 +++++++++++++++++++++++++++++++++++ libguile/numbers.h | 2 ++ module/rnrs/base.scm | 3 -- test-suite/tests/numbers.test | 48 ++++++++++++++++++++++++++ 7 files changed, 142 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index b53386a0b..206153ac4 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,21 @@ See the end for copying conditions. Please send Guile bug reports to bug-guile@gnu.org. +Changes in 2.0.1 (since 2.0.0): + +* New procedures (see the manual for details) + +** exact-integer-sqrt, imported into core from (rnrs base) + +* Bugs fixed + +** exact-integer-sqrt now handles large integers correctly + +exact-integer-sqrt now works correctly when applied to very large +integers (too large to be precisely represented by a C double). +It has also been imported into core from (rnrs base). + + Changes in 2.0.0 (changes since the 1.8.x series): * New modules (see the manual for details) diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 2b407ea99..760039a32 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -959,6 +959,18 @@ Return @var{n} raised to the integer exponent @end lisp @end deffn +@deftypefn {Scheme Procedure} {} exact-integer-sqrt @var{k} +@deftypefnx {C Function} void scm_exact_integer_sqrt (SCM @var{k}, SCM *@var{s}, SCM *@var{r}) +Return two exact non-negative integers @var{s} and @var{r} +such that @math{@var{k} = @var{s}^2 + @var{r}} and +@math{@var{s}^2 <= @var{k} < (@var{s} + 1)^2}. +An error is raised if @var{k} is not an exact non-negative integer. + +@lisp +(exact-integer-sqrt 10) @result{} 3 and 1 +@end lisp +@end deftypefn + @node Comparison @subsubsection Comparison Predicates @rnindex zero? diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi index 8f8928659..bc569ed69 100644 --- a/doc/ref/r6rs.texi +++ b/doc/ref/r6rs.texi @@ -379,6 +379,7 @@ grouped below by the existing manual sections to which they correspond. @deffnx {Scheme Procedure} even? n @deffnx {Scheme Procedure} gcd x ... @deffnx {Scheme Procedure} lcm x ... +@deffnx {Scheme Procedure} exact-integer-sqrt k @xref{Integer Operations}, for documentation. @end deffn @@ -525,11 +526,6 @@ This is a consequence of the requirement that @end lisp @end deffn -@deffn {Scheme Procedure} exact-integer-sqrt k -This procedure returns two nonnegative integer objects @code{s} and -@code{r} such that k = s^2 + r and k < (s + 1)^2. -@end deffn - @deffn {Scheme Procedure} real-valued? obj @deffnx {Scheme Procedure} rational-valued? obj @deffnx {Scheme Procedure} integer-valued? obj diff --git a/libguile/numbers.c b/libguile/numbers.c index b4f224240..74753812b 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -9555,6 +9555,70 @@ SCM_PRIMITIVE_GENERIC (scm_exp, "exp", 1, 0, 0, #undef FUNC_NAME +SCM_DEFINE (scm_i_exact_integer_sqrt, "exact-integer-sqrt", 1, 0, 0, + (SCM k), + "Return two exact non-negative integers @var{s} and @var{r}\n" + "such that @math{@var{k} = @var{s}^2 + @var{r}} and\n" + "@math{@var{s}^2 <= @var{k} < (@var{s} + 1)^2}.\n" + "An error is raised if @var{k} is not an exact non-negative integer.\n" + "\n" + "@lisp\n" + "(exact-integer-sqrt 10) @result{} 3 and 1\n" + "@end lisp") +#define FUNC_NAME s_scm_i_exact_integer_sqrt +{ + SCM s, r; + + scm_exact_integer_sqrt (k, &s, &r); + return scm_values (scm_list_2 (s, r)); +} +#undef FUNC_NAME + +void +scm_exact_integer_sqrt (SCM k, SCM *sp, SCM *rp) +{ + if (SCM_LIKELY (SCM_I_INUMP (k))) + { + scm_t_inum kk = SCM_I_INUM (k); + scm_t_inum uu = kk; + scm_t_inum ss; + + if (SCM_LIKELY (kk > 0)) + { + do + { + ss = uu; + uu = (ss + kk/ss) / 2; + } while (uu < ss); + *sp = SCM_I_MAKINUM (ss); + *rp = SCM_I_MAKINUM (kk - ss*ss); + } + else if (SCM_LIKELY (kk == 0)) + *sp = *rp = SCM_INUM0; + else + scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k, + "exact non-negative integer"); + } + else if (SCM_LIKELY (SCM_BIGP (k))) + { + SCM s, r; + + if (mpz_sgn (SCM_I_BIG_MPZ (k)) < 0) + scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k, + "exact non-negative integer"); + s = scm_i_mkbig (); + r = scm_i_mkbig (); + mpz_sqrtrem (SCM_I_BIG_MPZ (s), SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (k)); + scm_remember_upto_here_1 (k); + *sp = scm_i_normbig (s); + *rp = scm_i_normbig (r); + } + else + scm_wrong_type_arg_msg ("exact-integer-sqrt", SCM_ARG1, k, + "exact non-negative integer"); +} + + SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0, (SCM z), "Return the square root of @var{z}. Of the two possible roots\n" diff --git a/libguile/numbers.h b/libguile/numbers.h index ab96981c6..d98583039 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -289,6 +289,7 @@ SCM_API SCM scm_log (SCM z); SCM_API SCM scm_log10 (SCM z); SCM_API SCM scm_exp (SCM z); SCM_API SCM scm_sqrt (SCM z); +SCM_API void scm_exact_integer_sqrt (SCM k, SCM *s, SCM *r); SCM_INTERNAL SCM scm_i_min (SCM x, SCM y, SCM rest); SCM_INTERNAL SCM scm_i_max (SCM x, SCM y, SCM rest); @@ -296,6 +297,7 @@ SCM_INTERNAL SCM scm_i_sum (SCM x, SCM y, SCM rest); SCM_INTERNAL SCM scm_i_difference (SCM x, SCM y, SCM rest); SCM_INTERNAL SCM scm_i_product (SCM x, SCM y, SCM rest); SCM_INTERNAL SCM scm_i_divide (SCM x, SCM y, SCM rest); +SCM_INTERNAL SCM scm_i_exact_integer_sqrt (SCM k); /* bignum internal functions */ SCM_INTERNAL SCM scm_i_mkbig (void); diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index 2f5a218de..b9dddab0b 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -103,9 +103,6 @@ (let ((sym (car syms))) (and (symbol? sym) (symbol=?-internal (cdr syms) sym))))) - (define (exact-integer-sqrt x) - (let* ((s (exact (floor (sqrt x)))) (e (- x (* s s)))) (values s e))) - (define (real-valued? x) (and (complex? x) (zero? (imag-part x)))) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index d94b6a14e..b1f3d8bc0 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -4546,6 +4546,54 @@ (pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF (lognot #x-100000000000000000000000000000000)))) +;;; +;;; exact-integer-sqrt +;;; + +(with-test-prefix "exact-integer-sqrt" + (define (non-negative-exact-integer? k) + (and (integer? k) (exact? k) (>= k 0))) + + (define (test k) + (pass-if k (let-values (((s r) (exact-integer-sqrt k))) + (and (non-negative-exact-integer? s) + (non-negative-exact-integer? r) + (= k (+ r (* s s))) + (< k (* (1+ s) (1+ s))))))) + + (define (test-wrong-type-arg k) + (pass-if-exception k exception:wrong-type-arg + (let-values (((s r) (exact-integer-sqrt k))) + #t))) + + (pass-if (documented? exact-integer-sqrt)) + + (pass-if-exception "no args" exception:wrong-num-args + (exact-integer-sqrt)) + (pass-if-exception "two args" exception:wrong-num-args + (exact-integer-sqrt 123 456)) + + (test 0) + (test 1) + (test 9) + (test 10) + (test fixnum-max) + (test (1+ fixnum-max)) + (test (* fixnum-max fixnum-max)) + (test (+ 1 (* fixnum-max fixnum-max))) + (test (expt 10 100)) + (test (+ 3 (expt 10 100))) + + (test-wrong-type-arg -1) + (test-wrong-type-arg 1/9) + (test-wrong-type-arg fixnum-min) + (test-wrong-type-arg (1- fixnum-min)) + (test-wrong-type-arg 1.0) + (test-wrong-type-arg 1.5) + (test-wrong-type-arg "foo") + (test-wrong-type-arg 'foo)) + + ;;; ;;; sqrt ;;; From adf43b3f081878860ed1d4d5091b9a432b44da90 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 11 Apr 2011 10:13:48 +0200 Subject: [PATCH 175/183] ignore SIGPIPE in (system repl server) * module/system/repl/server.scm (run-server): Ignore SIGPIPE when we run a server, as otherwise a rudely disconnected client could cause the server to quit. Thanks to John Proctor for the report, and Detlev Zundel for the debugging. --- module/system/repl/server.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm index 132ea81aa..ec9067745 100644 --- a/module/system/repl/server.scm +++ b/module/system/repl/server.scm @@ -1,6 +1,6 @@ ;;; Repl server -;; Copyright (C) 2003, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2010, 2011 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -103,6 +103,7 @@ (sleep 1) (accept-new-client)))))) + (sigaction SIGPIPE SIG_IGN) (add-open-socket! server-socket) (listen server-socket 5) (let lp ((client (accept-new-client))) From 15671c6e7fd86160b415b5373b2c1539e23556f3 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 11 Apr 2011 11:52:35 +0200 Subject: [PATCH 176/183] refactor scm_i_print_symbol_name * libguile/print.c (symbol_has_extended_read_syntax) (print_normal_symbol, print_extended_symbol, scm_i_print_symbol_name): Factor scm_i_print_symbol_name into separate routines. Add comments. There are a number of bugs here. --- libguile/print.c | 194 ++++++++++++++++++++++++++--------------------- 1 file changed, 109 insertions(+), 85 deletions(-) diff --git a/libguile/print.c b/libguile/print.c index e3c9e1c92..37a6cafa1 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -309,15 +309,10 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref) /* Print the name of a symbol. */ static int -quote_keywordish_symbol (SCM symbol) +quote_keywordish_symbols (void) { - SCM option; + SCM option = SCM_PRINT_KEYWORD_STYLE; - if (scm_i_symbol_ref (symbol, 0) != ':' - && scm_i_symbol_ref (symbol, scm_i_symbol_length (symbol) - 1) != ':') - return 0; - - option = SCM_PRINT_KEYWORD_STYLE; if (scm_is_false (option)) return 0; if (scm_is_eq (option, sym_reader)) @@ -325,91 +320,120 @@ quote_keywordish_symbol (SCM symbol) return 1; } -void -scm_i_print_symbol_name (SCM str, SCM port) +static int +symbol_has_extended_read_syntax (SCM sym) { - /* This points to the first character that has not yet been written to the - * port. */ - size_t pos = 0; - /* This points to the character we're currently looking at. */ - size_t end; - /* If the name contains weird characters, we'll escape them with - * backslashes and set this flag; it indicates that we should surround the - * name with "#{" and "}#". */ - int weird = 0; - /* Backslashes are not sufficient to make a name weird, but if a name is - * weird because of other characters, backslahes need to be escaped too. - * The first time we see a backslash, we set maybe_weird, and mw_pos points - * to the backslash. Then if the name turns out to be weird, we re-process - * everything starting from mw_pos. - * We could instead make backslashes always weird. This is not necessary - * to ensure that the output is (read)-able, but it would make this code - * simpler and faster. */ - int maybe_weird = 0; - size_t mw_pos = 0; - size_t len = scm_i_symbol_length (str); - scm_t_wchar str0 = scm_i_symbol_ref (str, 0); + size_t pos, len = scm_i_symbol_length (sym); + scm_t_wchar c; - if (len == 0 || str0 == '\'' || str0 == '`' || str0 == ',' - || quote_keywordish_symbol (str) - || (str0 == '.' && len == 1) - || scm_is_true (scm_i_string_to_number (scm_symbol_to_string (str), 10))) + /* The empty symbol. */ + if (len == 0) + return 1; + + c = scm_i_symbol_ref (sym, 0); + + /* Single dot; conflicts with dotted-pair notation. */ + if (len == 1 && c == '.') + return 1; + + /* Other initial-character constraints. */ + if (c == '\'' || c == '`' || c == ',') + return 1; + + /* Keywords can be identified by trailing colons too. */ + if (c == ':' || scm_i_symbol_ref (sym, len - 1) == ':') + return quote_keywordish_symbols (); + + /* Number-ish symbols. */ + if (scm_is_true (scm_i_string_to_number (scm_symbol_to_string (sym), 10))) + return 1; + + /* Otherwise assume everything is fine, unless one of these chars is + present. This is incorrect, but it's the way Guile has done it for + quite some time. */ + for (pos = 0; pos < len; pos++) { - scm_lfwrite ("#{", 2, port); - weird = 1; + switch (scm_i_symbol_ref (sym, pos)) + { +#ifdef BRACKETS_AS_PARENS + case '[': + case ']': +#endif + case '(': + case ')': + case '"': + case ';': + case '#': + case SCM_WHITE_SPACES: + case SCM_LINE_INCREMENTORS: + return 1; + default: + break; + } } - for (end = pos; end < len; ++end) - switch (scm_i_symbol_ref (str, end)) - { + return 0; +} + +static void +print_normal_symbol (SCM sym, SCM port) +{ + scm_display (scm_symbol_to_string (sym), port); +} + +/* This is not the right logic, because it doesn't do anything special + for }# within a symbol, and there is no read logic to handle + escapes. We'll fix that in a future patch. */ +static void +print_extended_symbol (SCM sym, SCM port) +{ + size_t pos, len; + scm_t_string_failed_conversion_handler strategy; + + len = scm_i_symbol_length (sym); + strategy = scm_i_get_conversion_strategy (port); + + scm_lfwrite ("#{", 2, port); + + for (pos = 0; pos < len; pos++) + { + scm_t_wchar c = scm_i_symbol_ref (sym, pos); + + switch (c) + { #ifdef BRACKETS_AS_PARENS - case '[': - case ']': + case '[': + case ']': #endif - case '(': - case ')': - case '"': - case ';': - case '#': - case SCM_WHITE_SPACES: - case SCM_LINE_INCREMENTORS: - weird_handler: - if (maybe_weird) - { - end = mw_pos; - maybe_weird = 0; - } - if (!weird) - { - scm_lfwrite ("#{", 2, port); - weird = 1; - } - if (pos < end) - scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port); - { - char buf[2]; - buf[0] = '\\'; - buf[1] = (char) (unsigned char) scm_i_symbol_ref (str, end); - scm_lfwrite (buf, 2, port); - } - pos = end + 1; - break; - case '\\': - if (weird) - goto weird_handler; - if (!maybe_weird) - { - maybe_weird = 1; - mw_pos = pos; - } - break; - default: - break; - } - if (pos < end) - scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port); - if (weird) - scm_lfwrite ("}#", 2, port); + case '(': + case ')': + case '"': + case ';': + case '#': + case SCM_WHITE_SPACES: + case SCM_LINE_INCREMENTORS: + display_character ('\\', port, iconveh_question_mark); + /* fall through */ + default: + if (!display_character (c, port, strategy)) + scm_encoding_error ("print_extended_symbol", errno, + "cannot convert to output locale", + port, SCM_MAKE_CHAR (c)); + break; + } + } + + scm_lfwrite ("}#", 2, port); +} + +/* FIXME: allow R6RS hex escapes instead of #{...}#. */ +void +scm_i_print_symbol_name (SCM sym, SCM port) +{ + if (symbol_has_extended_read_syntax (sym)) + print_extended_symbol (sym, port); + else + print_normal_symbol (sym, port); } void From d9527cfafdad1046770437a7a59d3745e7243c67 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 11 Apr 2011 12:48:06 +0200 Subject: [PATCH 177/183] read-extended-symbol handles backslash better, including r6rs hex escapes * libguile/read.c (scm_read_extended_symbol): Interpret '\' as an escape character. Due to some historical oddities we have to support '\' before any character, but since we never emitted '\' in front of "normal" characters like 'x' we can interpret "\x..;" to be an R6RS hex escape. * test-suite/tests/reader.test ("#{}#"): Add tests. --- libguile/read.c | 55 ++++++++++++++++++++++++++++++------ test-suite/tests/reader.test | 12 ++++++++ 2 files changed, 59 insertions(+), 8 deletions(-) diff --git a/libguile/read.c b/libguile/read.c index a05a86d40..4b6828b8a 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1230,7 +1230,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) #{This is all a symbol name}# So here, CHR is expected to be `{'. */ - int saw_brace = 0, finished = 0; + int saw_brace = 0; size_t len = 0; SCM buf = scm_i_make_string (1024, NULL, 0); @@ -1242,20 +1242,57 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) { if (chr == '#') { - finished = 1; break; } else { saw_brace = 0; scm_i_string_set_x (buf, len++, '}'); - scm_i_string_set_x (buf, len++, chr); } } - else if (chr == '}') + + if (chr == '}') saw_brace = 1; + else if (chr == '\\') + { + /* It used to be that print.c would print extended-read-syntax + symbols with backslashes before "non-standard" chars, but + this routine wouldn't do anything with those escapes. + Bummer. What we've done is to change print.c to output + R6RS hex escapes for those characters, relying on the fact + that the extended read syntax would never put a `\' before + an `x'. For now, we just ignore other instances of + backslash in the string. */ + switch ((chr = scm_getc (port))) + { + case EOF: + goto done; + case 'x': + { + scm_t_wchar c; + + SCM_READ_HEX_ESCAPE (10, ';'); + scm_i_string_set_x (buf, len++, c); + break; + + str_eof: + chr = EOF; + goto done; + + bad_escaped: + scm_i_string_stop_writing (); + scm_i_input_error ("scm_read_extended_symbol", port, + "illegal character in escape sequence: ~S", + scm_list_1 (SCM_MAKE_CHAR (c))); + break; + } + default: + scm_i_string_set_x (buf, len++, chr); + break; + } + } else - scm_i_string_set_x (buf, len++, chr); + scm_i_string_set_x (buf, len++, chr); if (len >= scm_i_string_length (buf) - 2) { @@ -1267,11 +1304,13 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) len = 0; buf = scm_i_string_start_writing (buf); } - - if (finished) - break; } + + done: scm_i_string_stop_writing (); + if (chr == EOF) + scm_i_input_error ("scm_read_extended_symbol", port, + "end of file while reading symbol", SCM_EOL); return (scm_string_to_symbol (scm_c_substring (buf, 0, len))); } diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 1d6cc41ff..7027d3255 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -36,6 +36,8 @@ (cons 'read-error "Unknown # object: .*$")) (define exception:eof-in-string (cons 'read-error "end of file in string constant$")) +(define exception:eof-in-symbol + (cons 'read-error "end of file while reading symbol$")) (define exception:illegal-escape (cons 'read-error "illegal character in escape sequence: .*$")) (define exception:missing-expression @@ -424,6 +426,16 @@ ("#,foo" . (unsyntax foo)) ("#,@foo" . (unsyntax-splicing foo))))) +(with-test-prefix "#{}#" + (pass-if (equal? (read-string "#{}#") '#{}#)) + (pass-if (equal? (read-string "#{a}#") 'a)) + (pass-if (equal? (read-string "#{a b}#") '#{a b}#)) + (begin-deprecated + (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))) + (pass-if-exception "#{" exception:eof-in-symbol + (read-string "#{")) + (pass-if (equal? (read-string "#{a\\x20;b}#") '#{a b}#))) + ;;; Local Variables: ;;; eval: (put 'with-read-options 'scheme-indent-function 1) From 2e9fc9fc73a8157152e6b2e122ec545d96478c2a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 11 Apr 2011 13:38:27 +0200 Subject: [PATCH 178/183] symbols with odd characters print better in #{}# * libguile/print.c (symbol_has_extended_read_syntax): Use a more general, unicode-appropriate algorithm. Hopefully doesn't cause any current #{}# cases to be unescaped. (print_extended_symbol): Use more appropriate unicode algorithm, and emit unicode hex escapes instead of our own lame escapes. * test-suite/tests/symbols.test: Add tests. --- libguile/print.c | 76 ++++++++++++++++------------------- test-suite/tests/symbols.test | 7 +++- 2 files changed, 41 insertions(+), 42 deletions(-) diff --git a/libguile/print.c b/libguile/print.c index 37a6cafa1..139956624 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -320,6 +320,18 @@ quote_keywordish_symbols (void) return 1; } +#define INITIAL_IDENTIFIER_MASK \ + (UC_CATEGORY_MASK_Lu | UC_CATEGORY_MASK_Ll | UC_CATEGORY_MASK_Lt \ + | UC_CATEGORY_MASK_Lm | UC_CATEGORY_MASK_Lo | UC_CATEGORY_MASK_Mn \ + | UC_CATEGORY_MASK_Nl | UC_CATEGORY_MASK_No | UC_CATEGORY_MASK_Pd \ + | UC_CATEGORY_MASK_Pc | UC_CATEGORY_MASK_Po | UC_CATEGORY_MASK_Sc \ + | UC_CATEGORY_MASK_Sm | UC_CATEGORY_MASK_Sk | UC_CATEGORY_MASK_So \ + | UC_CATEGORY_MASK_Co) + +#define SUBSEQUENT_IDENTIFIER_MASK \ + (INITIAL_IDENTIFIER_MASK \ + | UC_CATEGORY_MASK_Nd | UC_CATEGORY_MASK_Mc | UC_CATEGORY_MASK_Me) + static int symbol_has_extended_read_syntax (SCM sym) { @@ -337,7 +349,7 @@ symbol_has_extended_read_syntax (SCM sym) return 1; /* Other initial-character constraints. */ - if (c == '\'' || c == '`' || c == ',') + if (c == '\'' || c == '`' || c == ',' || c == '"' || c == ';' || c == '#') return 1; /* Keywords can be identified by trailing colons too. */ @@ -348,28 +360,20 @@ symbol_has_extended_read_syntax (SCM sym) if (scm_is_true (scm_i_string_to_number (scm_symbol_to_string (sym), 10))) return 1; - /* Otherwise assume everything is fine, unless one of these chars is - present. This is incorrect, but it's the way Guile has done it for - quite some time. */ - for (pos = 0; pos < len; pos++) + /* Other disallowed first characters. */ + if (!uc_is_general_category_withtable (c, INITIAL_IDENTIFIER_MASK)) + return 1; + + /* Otherwise, any character that's in the identifier category mask is + fine to pass through as-is, provided it's not one of the ASCII + delimiters like `;'. */ + for (pos = 1; pos < len; pos++) { - switch (scm_i_symbol_ref (sym, pos)) - { -#ifdef BRACKETS_AS_PARENS - case '[': - case ']': -#endif - case '(': - case ')': - case '"': - case ';': - case '#': - case SCM_WHITE_SPACES: - case SCM_LINE_INCREMENTORS: - return 1; - default: - break; - } + c = scm_i_symbol_ref (sym, pos); + if (!uc_is_general_category_withtable (c, SUBSEQUENT_IDENTIFIER_MASK)) + return 1; + else if (c == '"' || c == ';' || c == '#') + return 1; } return 0; @@ -381,9 +385,6 @@ print_normal_symbol (SCM sym, SCM port) scm_display (scm_symbol_to_string (sym), port); } -/* This is not the right logic, because it doesn't do anything special - for }# within a symbol, and there is no read logic to handle - escapes. We'll fix that in a future patch. */ static void print_extended_symbol (SCM sym, SCM port) { @@ -399,27 +400,20 @@ print_extended_symbol (SCM sym, SCM port) { scm_t_wchar c = scm_i_symbol_ref (sym, pos); - switch (c) + if (uc_is_general_category_withtable (c, + SUBSEQUENT_IDENTIFIER_MASK + | UC_CATEGORY_MASK_Zs)) { -#ifdef BRACKETS_AS_PARENS - case '[': - case ']': -#endif - case '(': - case ')': - case '"': - case ';': - case '#': - case SCM_WHITE_SPACES: - case SCM_LINE_INCREMENTORS: - display_character ('\\', port, iconveh_question_mark); - /* fall through */ - default: if (!display_character (c, port, strategy)) scm_encoding_error ("print_extended_symbol", errno, "cannot convert to output locale", port, SCM_MAKE_CHAR (c)); - break; + } + else + { + display_string ("\\x", 1, 2, port, iconveh_question_mark); + scm_intprint (c, 16, port); + display_character (';', port, iconveh_question_mark); } } diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test index c87aa21d1..6fbc6be73 100644 --- a/test-suite/tests/symbols.test +++ b/test-suite/tests/symbols.test @@ -1,6 +1,6 @@ ;;;; symbols.test --- test suite for Guile's symbols -*- scheme -*- ;;;; -;;;; Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -151,3 +151,8 @@ (pass-if "accepts embedded NULs" (> (string-length (symbol->string (gensym "foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0"))) 6))) +(with-test-prefix "extended read syntax" + (pass-if (equal? "#{}#" (object->string (string->symbol "")))) + (pass-if (equal? "a" (object->string (string->symbol "a")))) + (pass-if (equal? "#{a b}#" (object->string (string->symbol "a b")))) + (pass-if (equal? "#{\\x7d;}#" (object->string (string->symbol "}"))))) From b9e22602bb9c7d82500e4e5612bf80e478e28b8c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 11 Apr 2011 13:49:29 +0200 Subject: [PATCH 179/183] regen psyntax-pp.scm * module/ice-9/psyntax-pp.scm: Regenerate, to take advantage of better #{}# serialization. --- module/ice-9/psyntax-pp.scm | 11065 +++++++++++++++++----------------- 1 file changed, 5485 insertions(+), 5580 deletions(-) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 53d591295..16c6a90a4 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -2,1579 +2,1571 @@ (if #f #f) (letrec* - ((#{and-map*\ 38}# - (lambda (#{f\ 202}# #{first\ 203}# . #{rest\ 204}#) + ((#{and-map* 38}# + (lambda (#{f 202}# #{first 203}# . #{rest 204}#) (begin - (let ((#{t\ 210}# (null? #{first\ 203}#))) - (if #{t\ 210}# - #{t\ 210}# - (if (null? #{rest\ 204}#) + (let ((#{t 210}# (null? #{first 203}#))) + (if #{t 210}# + #{t 210}# + (if (null? #{rest 204}#) (letrec* - ((#{andmap\ 214}# - (lambda (#{first\ 215}#) + ((#{andmap 214}# + (lambda (#{first 215}#) (begin - (let ((#{x\ 218}# (car #{first\ 215}#)) - (#{first\ 219}# (cdr #{first\ 215}#))) - (if (null? #{first\ 219}#) - (#{f\ 202}# #{x\ 218}#) - (if (#{f\ 202}# #{x\ 218}#) - (#{andmap\ 214}# #{first\ 219}#) + (let ((#{x 218}# (car #{first 215}#)) + (#{first 219}# (cdr #{first 215}#))) + (if (null? #{first 219}#) + (#{f 202}# #{x 218}#) + (if (#{f 202}# #{x 218}#) + (#{andmap 214}# #{first 219}#) #f))))))) - (begin (#{andmap\ 214}# #{first\ 203}#))) + (begin (#{andmap 214}# #{first 203}#))) (letrec* - ((#{andmap\ 225}# - (lambda (#{first\ 226}# #{rest\ 227}#) + ((#{andmap 225}# + (lambda (#{first 226}# #{rest 227}#) (begin - (let ((#{x\ 232}# (car #{first\ 226}#)) - (#{xr\ 233}# (map car #{rest\ 227}#)) - (#{first\ 234}# (cdr #{first\ 226}#)) - (#{rest\ 235}# (map cdr #{rest\ 227}#))) - (if (null? #{first\ 234}#) - (@apply #{f\ 202}# #{x\ 232}# #{xr\ 233}#) - (if (@apply #{f\ 202}# #{x\ 232}# #{xr\ 233}#) - (#{andmap\ 225}# #{first\ 234}# #{rest\ 235}#) + (let ((#{x 232}# (car #{first 226}#)) + (#{xr 233}# (map car #{rest 227}#)) + (#{first 234}# (cdr #{first 226}#)) + (#{rest 235}# (map cdr #{rest 227}#))) + (if (null? #{first 234}#) + (@apply #{f 202}# #{x 232}# #{xr 233}#) + (if (@apply #{f 202}# #{x 232}# #{xr 233}#) + (#{andmap 225}# #{first 234}# #{rest 235}#) #f))))))) (begin - (#{andmap\ 225}# #{first\ 203}# #{rest\ 204}#)))))))))) + (#{andmap 225}# #{first 203}# #{rest 204}#)))))))))) (begin (letrec* - ((#{make-void\ 240}# - (lambda (#{src\ 798}#) + ((#{make-void 240}# + (lambda (#{src 798}#) (make-struct/no-tail (vector-ref %expanded-vtables 0) - #{src\ 798}#))) - (#{make-const\ 242}# - (lambda (#{src\ 800}# #{exp\ 801}#) + #{src 798}#))) + (#{make-const 242}# + (lambda (#{src 800}# #{exp 801}#) (make-struct/no-tail (vector-ref %expanded-vtables 1) - #{src\ 800}# - #{exp\ 801}#))) - (#{make-lexical-ref\ 246}# - (lambda (#{src\ 808}# #{name\ 809}# #{gensym\ 810}#) + #{src 800}# + #{exp 801}#))) + (#{make-lexical-ref 246}# + (lambda (#{src 808}# #{name 809}# #{gensym 810}#) (make-struct/no-tail (vector-ref %expanded-vtables 3) - #{src\ 808}# - #{name\ 809}# - #{gensym\ 810}#))) - (#{make-lexical-set\ 248}# - (lambda (#{src\ 814}# - #{name\ 815}# - #{gensym\ 816}# - #{exp\ 817}#) + #{src 808}# + #{name 809}# + #{gensym 810}#))) + (#{make-lexical-set 248}# + (lambda (#{src 814}# + #{name 815}# + #{gensym 816}# + #{exp 817}#) (make-struct/no-tail (vector-ref %expanded-vtables 4) - #{src\ 814}# - #{name\ 815}# - #{gensym\ 816}# - #{exp\ 817}#))) - (#{make-module-ref\ 250}# - (lambda (#{src\ 822}# - #{mod\ 823}# - #{name\ 824}# - #{public?\ 825}#) + #{src 814}# + #{name 815}# + #{gensym 816}# + #{exp 817}#))) + (#{make-module-ref 250}# + (lambda (#{src 822}# + #{mod 823}# + #{name 824}# + #{public? 825}#) (make-struct/no-tail (vector-ref %expanded-vtables 5) - #{src\ 822}# - #{mod\ 823}# - #{name\ 824}# - #{public?\ 825}#))) - (#{make-module-set\ 252}# - (lambda (#{src\ 830}# - #{mod\ 831}# - #{name\ 832}# - #{public?\ 833}# - #{exp\ 834}#) + #{src 822}# + #{mod 823}# + #{name 824}# + #{public? 825}#))) + (#{make-module-set 252}# + (lambda (#{src 830}# + #{mod 831}# + #{name 832}# + #{public? 833}# + #{exp 834}#) (make-struct/no-tail (vector-ref %expanded-vtables 6) - #{src\ 830}# - #{mod\ 831}# - #{name\ 832}# - #{public?\ 833}# - #{exp\ 834}#))) - (#{make-toplevel-ref\ 254}# - (lambda (#{src\ 840}# #{name\ 841}#) + #{src 830}# + #{mod 831}# + #{name 832}# + #{public? 833}# + #{exp 834}#))) + (#{make-toplevel-ref 254}# + (lambda (#{src 840}# #{name 841}#) (make-struct/no-tail (vector-ref %expanded-vtables 7) - #{src\ 840}# - #{name\ 841}#))) - (#{make-toplevel-set\ 256}# - (lambda (#{src\ 844}# #{name\ 845}# #{exp\ 846}#) + #{src 840}# + #{name 841}#))) + (#{make-toplevel-set 256}# + (lambda (#{src 844}# #{name 845}# #{exp 846}#) (make-struct/no-tail (vector-ref %expanded-vtables 8) - #{src\ 844}# - #{name\ 845}# - #{exp\ 846}#))) - (#{make-toplevel-define\ 258}# - (lambda (#{src\ 850}# #{name\ 851}# #{exp\ 852}#) + #{src 844}# + #{name 845}# + #{exp 846}#))) + (#{make-toplevel-define 258}# + (lambda (#{src 850}# #{name 851}# #{exp 852}#) (make-struct/no-tail (vector-ref %expanded-vtables 9) - #{src\ 850}# - #{name\ 851}# - #{exp\ 852}#))) - (#{make-conditional\ 260}# - (lambda (#{src\ 856}# - #{test\ 857}# - #{consequent\ 858}# - #{alternate\ 859}#) + #{src 850}# + #{name 851}# + #{exp 852}#))) + (#{make-conditional 260}# + (lambda (#{src 856}# + #{test 857}# + #{consequent 858}# + #{alternate 859}#) (make-struct/no-tail (vector-ref %expanded-vtables 10) - #{src\ 856}# - #{test\ 857}# - #{consequent\ 858}# - #{alternate\ 859}#))) - (#{make-application\ 262}# - (lambda (#{src\ 864}# #{proc\ 865}# #{args\ 866}#) + #{src 856}# + #{test 857}# + #{consequent 858}# + #{alternate 859}#))) + (#{make-application 262}# + (lambda (#{src 864}# #{proc 865}# #{args 866}#) (make-struct/no-tail (vector-ref %expanded-vtables 11) - #{src\ 864}# - #{proc\ 865}# - #{args\ 866}#))) - (#{make-sequence\ 264}# - (lambda (#{src\ 870}# #{exps\ 871}#) + #{src 864}# + #{proc 865}# + #{args 866}#))) + (#{make-sequence 264}# + (lambda (#{src 870}# #{exps 871}#) (make-struct/no-tail (vector-ref %expanded-vtables 12) - #{src\ 870}# - #{exps\ 871}#))) - (#{make-lambda\ 266}# - (lambda (#{src\ 874}# #{meta\ 875}# #{body\ 876}#) + #{src 870}# + #{exps 871}#))) + (#{make-lambda 266}# + (lambda (#{src 874}# #{meta 875}# #{body 876}#) (make-struct/no-tail (vector-ref %expanded-vtables 13) - #{src\ 874}# - #{meta\ 875}# - #{body\ 876}#))) - (#{make-lambda-case\ 268}# - (lambda (#{src\ 880}# - #{req\ 881}# - #{opt\ 882}# - #{rest\ 883}# - #{kw\ 884}# - #{inits\ 885}# - #{gensyms\ 886}# - #{body\ 887}# - #{alternate\ 888}#) + #{src 874}# + #{meta 875}# + #{body 876}#))) + (#{make-lambda-case 268}# + (lambda (#{src 880}# + #{req 881}# + #{opt 882}# + #{rest 883}# + #{kw 884}# + #{inits 885}# + #{gensyms 886}# + #{body 887}# + #{alternate 888}#) (make-struct/no-tail (vector-ref %expanded-vtables 14) - #{src\ 880}# - #{req\ 881}# - #{opt\ 882}# - #{rest\ 883}# - #{kw\ 884}# - #{inits\ 885}# - #{gensyms\ 886}# - #{body\ 887}# - #{alternate\ 888}#))) - (#{make-let\ 270}# - (lambda (#{src\ 898}# - #{names\ 899}# - #{gensyms\ 900}# - #{vals\ 901}# - #{body\ 902}#) + #{src 880}# + #{req 881}# + #{opt 882}# + #{rest 883}# + #{kw 884}# + #{inits 885}# + #{gensyms 886}# + #{body 887}# + #{alternate 888}#))) + (#{make-let 270}# + (lambda (#{src 898}# + #{names 899}# + #{gensyms 900}# + #{vals 901}# + #{body 902}#) (make-struct/no-tail (vector-ref %expanded-vtables 15) - #{src\ 898}# - #{names\ 899}# - #{gensyms\ 900}# - #{vals\ 901}# - #{body\ 902}#))) - (#{make-letrec\ 272}# - (lambda (#{src\ 908}# - #{in-order?\ 909}# - #{names\ 910}# - #{gensyms\ 911}# - #{vals\ 912}# - #{body\ 913}#) + #{src 898}# + #{names 899}# + #{gensyms 900}# + #{vals 901}# + #{body 902}#))) + (#{make-letrec 272}# + (lambda (#{src 908}# + #{in-order? 909}# + #{names 910}# + #{gensyms 911}# + #{vals 912}# + #{body 913}#) (make-struct/no-tail (vector-ref %expanded-vtables 16) - #{src\ 908}# - #{in-order?\ 909}# - #{names\ 910}# - #{gensyms\ 911}# - #{vals\ 912}# - #{body\ 913}#))) - (#{make-dynlet\ 274}# - (lambda (#{src\ 920}# - #{fluids\ 921}# - #{vals\ 922}# - #{body\ 923}#) + #{src 908}# + #{in-order? 909}# + #{names 910}# + #{gensyms 911}# + #{vals 912}# + #{body 913}#))) + (#{make-dynlet 274}# + (lambda (#{src 920}# + #{fluids 921}# + #{vals 922}# + #{body 923}#) (make-struct/no-tail (vector-ref %expanded-vtables 17) - #{src\ 920}# - #{fluids\ 921}# - #{vals\ 922}# - #{body\ 923}#))) - (#{lambda?\ 277}# - (lambda (#{x\ 928}#) - (if (struct? #{x\ 928}#) - (eq? (struct-vtable #{x\ 928}#) + #{src 920}# + #{fluids 921}# + #{vals 922}# + #{body 923}#))) + (#{lambda? 277}# + (lambda (#{x 928}#) + (if (struct? #{x 928}#) + (eq? (struct-vtable #{x 928}#) (vector-ref %expanded-vtables 13)) #f))) - (#{lambda-meta\ 279}# - (lambda (#{x\ 932}#) (struct-ref #{x\ 932}# 1))) - (#{set-lambda-meta!\ 281}# - (lambda (#{x\ 934}# #{v\ 935}#) - (struct-set! #{x\ 934}# 1 #{v\ 935}#))) - (#{top-level-eval-hook\ 287}# - (lambda (#{x\ 938}# #{mod\ 939}#) - (primitive-eval #{x\ 938}#))) - (#{local-eval-hook\ 289}# - (lambda (#{x\ 942}# #{mod\ 943}#) - (primitive-eval #{x\ 942}#))) - (#{put-global-definition-hook\ 292}# - (lambda (#{symbol\ 946}# #{type\ 947}# #{val\ 948}#) + (#{lambda-meta 279}# + (lambda (#{x 932}#) (struct-ref #{x 932}# 1))) + (#{set-lambda-meta! 281}# + (lambda (#{x 934}# #{v 935}#) + (struct-set! #{x 934}# 1 #{v 935}#))) + (#{top-level-eval-hook 287}# + (lambda (#{x 938}# #{mod 939}#) + (primitive-eval #{x 938}#))) + (#{local-eval-hook 289}# + (lambda (#{x 942}# #{mod 943}#) + (primitive-eval #{x 942}#))) + (#{put-global-definition-hook 292}# + (lambda (#{symbol 946}# #{type 947}# #{val 948}#) (module-define! (current-module) - #{symbol\ 946}# + #{symbol 946}# (make-syntax-transformer - #{symbol\ 946}# - #{type\ 947}# - #{val\ 948}#)))) - (#{get-global-definition-hook\ 294}# - (lambda (#{symbol\ 952}# #{module\ 953}#) + #{symbol 946}# + #{type 947}# + #{val 948}#)))) + (#{get-global-definition-hook 294}# + (lambda (#{symbol 952}# #{module 953}#) (begin - (if (if (not #{module\ 953}#) (current-module) #f) + (if (if (not #{module 953}#) (current-module) #f) (warn "module system is booted, we should have a module" - #{symbol\ 952}#)) + #{symbol 952}#)) (begin - (let ((#{v\ 959}# (module-variable - (if #{module\ 953}# - (resolve-module (cdr #{module\ 953}#)) - (current-module)) - #{symbol\ 952}#))) - (if #{v\ 959}# - (if (variable-bound? #{v\ 959}#) + (let ((#{v 959}# (module-variable + (if #{module 953}# + (resolve-module (cdr #{module 953}#)) + (current-module)) + #{symbol 952}#))) + (if #{v 959}# + (if (variable-bound? #{v 959}#) (begin - (let ((#{val\ 964}# (variable-ref #{v\ 959}#))) - (if (macro? #{val\ 964}#) - (if (macro-type #{val\ 964}#) - (cons (macro-type #{val\ 964}#) - (macro-binding #{val\ 964}#)) + (let ((#{val 964}# (variable-ref #{v 959}#))) + (if (macro? #{val 964}#) + (if (macro-type #{val 964}#) + (cons (macro-type #{val 964}#) + (macro-binding #{val 964}#)) #f) #f))) #f) #f)))))) - (#{decorate-source\ 296}# - (lambda (#{e\ 968}# #{s\ 969}#) + (#{decorate-source 296}# + (lambda (#{e 968}# #{s 969}#) (begin - (if (if (pair? #{e\ 968}#) #{s\ 969}# #f) - (set-source-properties! #{e\ 968}# #{s\ 969}#)) - #{e\ 968}#))) - (#{maybe-name-value!\ 298}# - (lambda (#{name\ 974}# #{val\ 975}#) - (if (#{lambda?\ 277}# #{val\ 975}#) + (if (if (pair? #{e 968}#) #{s 969}# #f) + (set-source-properties! #{e 968}# #{s 969}#)) + #{e 968}#))) + (#{maybe-name-value! 298}# + (lambda (#{name 974}# #{val 975}#) + (if (#{lambda? 277}# #{val 975}#) (begin - (let ((#{meta\ 979}# - (#{lambda-meta\ 279}# #{val\ 975}#))) - (if (not (assq 'name #{meta\ 979}#)) - (#{set-lambda-meta!\ 281}# - #{val\ 975}# - (cons (cons 'name #{name\ 974}#) #{meta\ 979}#)))))))) - (#{build-void\ 300}# - (lambda (#{source\ 980}#) - (#{make-void\ 240}# #{source\ 980}#))) - (#{build-application\ 302}# - (lambda (#{source\ 982}# - #{fun-exp\ 983}# - #{arg-exps\ 984}#) - (#{make-application\ 262}# - #{source\ 982}# - #{fun-exp\ 983}# - #{arg-exps\ 984}#))) - (#{build-conditional\ 304}# - (lambda (#{source\ 988}# - #{test-exp\ 989}# - #{then-exp\ 990}# - #{else-exp\ 991}#) - (#{make-conditional\ 260}# - #{source\ 988}# - #{test-exp\ 989}# - #{then-exp\ 990}# - #{else-exp\ 991}#))) - (#{build-dynlet\ 306}# - (lambda (#{source\ 996}# - #{fluids\ 997}# - #{vals\ 998}# - #{body\ 999}#) - (#{make-dynlet\ 274}# - #{source\ 996}# - #{fluids\ 997}# - #{vals\ 998}# - #{body\ 999}#))) - (#{build-lexical-reference\ 308}# - (lambda (#{type\ 1004}# - #{source\ 1005}# - #{name\ 1006}# - #{var\ 1007}#) - (#{make-lexical-ref\ 246}# - #{source\ 1005}# - #{name\ 1006}# - #{var\ 1007}#))) - (#{build-lexical-assignment\ 310}# - (lambda (#{source\ 1012}# - #{name\ 1013}# - #{var\ 1014}# - #{exp\ 1015}#) + (let ((#{meta 979}# (#{lambda-meta 279}# #{val 975}#))) + (if (not (assq 'name #{meta 979}#)) + (#{set-lambda-meta! 281}# + #{val 975}# + (cons (cons 'name #{name 974}#) #{meta 979}#)))))))) + (#{build-void 300}# + (lambda (#{source 980}#) + (#{make-void 240}# #{source 980}#))) + (#{build-application 302}# + (lambda (#{source 982}# #{fun-exp 983}# #{arg-exps 984}#) + (#{make-application 262}# + #{source 982}# + #{fun-exp 983}# + #{arg-exps 984}#))) + (#{build-conditional 304}# + (lambda (#{source 988}# + #{test-exp 989}# + #{then-exp 990}# + #{else-exp 991}#) + (#{make-conditional 260}# + #{source 988}# + #{test-exp 989}# + #{then-exp 990}# + #{else-exp 991}#))) + (#{build-dynlet 306}# + (lambda (#{source 996}# + #{fluids 997}# + #{vals 998}# + #{body 999}#) + (#{make-dynlet 274}# + #{source 996}# + #{fluids 997}# + #{vals 998}# + #{body 999}#))) + (#{build-lexical-reference 308}# + (lambda (#{type 1004}# + #{source 1005}# + #{name 1006}# + #{var 1007}#) + (#{make-lexical-ref 246}# + #{source 1005}# + #{name 1006}# + #{var 1007}#))) + (#{build-lexical-assignment 310}# + (lambda (#{source 1012}# + #{name 1013}# + #{var 1014}# + #{exp 1015}#) (begin - (#{maybe-name-value!\ 298}# - #{name\ 1013}# - #{exp\ 1015}#) - (#{make-lexical-set\ 248}# - #{source\ 1012}# - #{name\ 1013}# - #{var\ 1014}# - #{exp\ 1015}#)))) - (#{analyze-variable\ 312}# - (lambda (#{mod\ 1020}# - #{var\ 1021}# - #{modref-cont\ 1022}# - #{bare-cont\ 1023}#) - (if (not #{mod\ 1020}#) - (#{bare-cont\ 1023}# #{var\ 1021}#) + (#{maybe-name-value! 298}# + #{name 1013}# + #{exp 1015}#) + (#{make-lexical-set 248}# + #{source 1012}# + #{name 1013}# + #{var 1014}# + #{exp 1015}#)))) + (#{analyze-variable 312}# + (lambda (#{mod 1020}# + #{var 1021}# + #{modref-cont 1022}# + #{bare-cont 1023}#) + (if (not #{mod 1020}#) + (#{bare-cont 1023}# #{var 1021}#) (begin - (let ((#{kind\ 1030}# (car #{mod\ 1020}#)) - (#{mod\ 1031}# (cdr #{mod\ 1020}#))) - (if (eqv? #{kind\ 1030}# 'public) - (#{modref-cont\ 1022}# - #{mod\ 1031}# - #{var\ 1021}# + (let ((#{kind 1030}# (car #{mod 1020}#)) + (#{mod 1031}# (cdr #{mod 1020}#))) + (if (eqv? #{kind 1030}# 'public) + (#{modref-cont 1022}# + #{mod 1031}# + #{var 1021}# #t) - (if (eqv? #{kind\ 1030}# 'private) + (if (eqv? #{kind 1030}# 'private) (if (not (equal? - #{mod\ 1031}# + #{mod 1031}# (module-name (current-module)))) - (#{modref-cont\ 1022}# - #{mod\ 1031}# - #{var\ 1021}# + (#{modref-cont 1022}# + #{mod 1031}# + #{var 1021}# #f) - (#{bare-cont\ 1023}# #{var\ 1021}#)) - (if (eqv? #{kind\ 1030}# 'bare) - (#{bare-cont\ 1023}# #{var\ 1021}#) - (if (eqv? #{kind\ 1030}# 'hygiene) + (#{bare-cont 1023}# #{var 1021}#)) + (if (eqv? #{kind 1030}# 'bare) + (#{bare-cont 1023}# #{var 1021}#) + (if (eqv? #{kind 1030}# 'hygiene) (if (if (not (equal? - #{mod\ 1031}# + #{mod 1031}# (module-name (current-module)))) (module-variable - (resolve-module #{mod\ 1031}#) - #{var\ 1021}#) + (resolve-module #{mod 1031}#) + #{var 1021}#) #f) - (#{modref-cont\ 1022}# - #{mod\ 1031}# - #{var\ 1021}# + (#{modref-cont 1022}# + #{mod 1031}# + #{var 1021}# #f) - (#{bare-cont\ 1023}# #{var\ 1021}#)) + (#{bare-cont 1023}# #{var 1021}#)) (syntax-violation #f "bad module kind" - #{var\ 1021}# - #{mod\ 1031}#)))))))))) - (#{build-global-reference\ 314}# - (lambda (#{source\ 1039}# #{var\ 1040}# #{mod\ 1041}#) - (#{analyze-variable\ 312}# - #{mod\ 1041}# - #{var\ 1040}# - (lambda (#{mod\ 1045}# #{var\ 1046}# #{public?\ 1047}#) - (#{make-module-ref\ 250}# - #{source\ 1039}# - #{mod\ 1045}# - #{var\ 1046}# - #{public?\ 1047}#)) - (lambda (#{var\ 1051}#) - (#{make-toplevel-ref\ 254}# - #{source\ 1039}# - #{var\ 1051}#))))) - (#{build-global-assignment\ 316}# - (lambda (#{source\ 1053}# - #{var\ 1054}# - #{exp\ 1055}# - #{mod\ 1056}#) + #{var 1021}# + #{mod 1031}#)))))))))) + (#{build-global-reference 314}# + (lambda (#{source 1039}# #{var 1040}# #{mod 1041}#) + (#{analyze-variable 312}# + #{mod 1041}# + #{var 1040}# + (lambda (#{mod 1045}# #{var 1046}# #{public? 1047}#) + (#{make-module-ref 250}# + #{source 1039}# + #{mod 1045}# + #{var 1046}# + #{public? 1047}#)) + (lambda (#{var 1051}#) + (#{make-toplevel-ref 254}# + #{source 1039}# + #{var 1051}#))))) + (#{build-global-assignment 316}# + (lambda (#{source 1053}# + #{var 1054}# + #{exp 1055}# + #{mod 1056}#) (begin - (#{maybe-name-value!\ 298}# - #{var\ 1054}# - #{exp\ 1055}#) - (#{analyze-variable\ 312}# - #{mod\ 1056}# - #{var\ 1054}# - (lambda (#{mod\ 1061}# #{var\ 1062}# #{public?\ 1063}#) - (#{make-module-set\ 252}# - #{source\ 1053}# - #{mod\ 1061}# - #{var\ 1062}# - #{public?\ 1063}# - #{exp\ 1055}#)) - (lambda (#{var\ 1067}#) - (#{make-toplevel-set\ 256}# - #{source\ 1053}# - #{var\ 1067}# - #{exp\ 1055}#)))))) - (#{build-global-definition\ 318}# - (lambda (#{source\ 1069}# #{var\ 1070}# #{exp\ 1071}#) + (#{maybe-name-value! 298}# + #{var 1054}# + #{exp 1055}#) + (#{analyze-variable 312}# + #{mod 1056}# + #{var 1054}# + (lambda (#{mod 1061}# #{var 1062}# #{public? 1063}#) + (#{make-module-set 252}# + #{source 1053}# + #{mod 1061}# + #{var 1062}# + #{public? 1063}# + #{exp 1055}#)) + (lambda (#{var 1067}#) + (#{make-toplevel-set 256}# + #{source 1053}# + #{var 1067}# + #{exp 1055}#)))))) + (#{build-global-definition 318}# + (lambda (#{source 1069}# #{var 1070}# #{exp 1071}#) (begin - (#{maybe-name-value!\ 298}# - #{var\ 1070}# - #{exp\ 1071}#) - (#{make-toplevel-define\ 258}# - #{source\ 1069}# - #{var\ 1070}# - #{exp\ 1071}#)))) - (#{build-simple-lambda\ 320}# - (lambda (#{src\ 1075}# - #{req\ 1076}# - #{rest\ 1077}# - #{vars\ 1078}# - #{meta\ 1079}# - #{exp\ 1080}#) - (#{make-lambda\ 266}# - #{src\ 1075}# - #{meta\ 1079}# - (#{make-lambda-case\ 268}# - #{src\ 1075}# - #{req\ 1076}# + (#{maybe-name-value! 298}# + #{var 1070}# + #{exp 1071}#) + (#{make-toplevel-define 258}# + #{source 1069}# + #{var 1070}# + #{exp 1071}#)))) + (#{build-simple-lambda 320}# + (lambda (#{src 1075}# + #{req 1076}# + #{rest 1077}# + #{vars 1078}# + #{meta 1079}# + #{exp 1080}#) + (#{make-lambda 266}# + #{src 1075}# + #{meta 1079}# + (#{make-lambda-case 268}# + #{src 1075}# + #{req 1076}# #f - #{rest\ 1077}# + #{rest 1077}# #f '() - #{vars\ 1078}# - #{exp\ 1080}# + #{vars 1078}# + #{exp 1080}# #f)))) - (#{build-case-lambda\ 322}# - (lambda (#{src\ 1087}# #{meta\ 1088}# #{body\ 1089}#) - (#{make-lambda\ 266}# - #{src\ 1087}# - #{meta\ 1088}# - #{body\ 1089}#))) - (#{build-lambda-case\ 324}# - (lambda (#{src\ 1093}# - #{req\ 1094}# - #{opt\ 1095}# - #{rest\ 1096}# - #{kw\ 1097}# - #{inits\ 1098}# - #{vars\ 1099}# - #{body\ 1100}# - #{else-case\ 1101}#) - (#{make-lambda-case\ 268}# - #{src\ 1093}# - #{req\ 1094}# - #{opt\ 1095}# - #{rest\ 1096}# - #{kw\ 1097}# - #{inits\ 1098}# - #{vars\ 1099}# - #{body\ 1100}# - #{else-case\ 1101}#))) - (#{build-primref\ 326}# - (lambda (#{src\ 1111}# #{name\ 1112}#) + (#{build-case-lambda 322}# + (lambda (#{src 1087}# #{meta 1088}# #{body 1089}#) + (#{make-lambda 266}# + #{src 1087}# + #{meta 1088}# + #{body 1089}#))) + (#{build-lambda-case 324}# + (lambda (#{src 1093}# + #{req 1094}# + #{opt 1095}# + #{rest 1096}# + #{kw 1097}# + #{inits 1098}# + #{vars 1099}# + #{body 1100}# + #{else-case 1101}#) + (#{make-lambda-case 268}# + #{src 1093}# + #{req 1094}# + #{opt 1095}# + #{rest 1096}# + #{kw 1097}# + #{inits 1098}# + #{vars 1099}# + #{body 1100}# + #{else-case 1101}#))) + (#{build-primref 326}# + (lambda (#{src 1111}# #{name 1112}#) (if (equal? (module-name (current-module)) '(guile)) - (#{make-toplevel-ref\ 254}# - #{src\ 1111}# - #{name\ 1112}#) - (#{make-module-ref\ 250}# - #{src\ 1111}# + (#{make-toplevel-ref 254}# + #{src 1111}# + #{name 1112}#) + (#{make-module-ref 250}# + #{src 1111}# '(guile) - #{name\ 1112}# + #{name 1112}# #f)))) - (#{build-data\ 328}# - (lambda (#{src\ 1115}# #{exp\ 1116}#) - (#{make-const\ 242}# #{src\ 1115}# #{exp\ 1116}#))) - (#{build-sequence\ 330}# - (lambda (#{src\ 1119}# #{exps\ 1120}#) - (if (null? (cdr #{exps\ 1120}#)) - (car #{exps\ 1120}#) - (#{make-sequence\ 264}# - #{src\ 1119}# - #{exps\ 1120}#)))) - (#{build-let\ 332}# - (lambda (#{src\ 1123}# - #{ids\ 1124}# - #{vars\ 1125}# - #{val-exps\ 1126}# - #{body-exp\ 1127}#) + (#{build-data 328}# + (lambda (#{src 1115}# #{exp 1116}#) + (#{make-const 242}# #{src 1115}# #{exp 1116}#))) + (#{build-sequence 330}# + (lambda (#{src 1119}# #{exps 1120}#) + (if (null? (cdr #{exps 1120}#)) + (car #{exps 1120}#) + (#{make-sequence 264}# + #{src 1119}# + #{exps 1120}#)))) + (#{build-let 332}# + (lambda (#{src 1123}# + #{ids 1124}# + #{vars 1125}# + #{val-exps 1126}# + #{body-exp 1127}#) (begin (for-each - #{maybe-name-value!\ 298}# - #{ids\ 1124}# - #{val-exps\ 1126}#) - (if (null? #{vars\ 1125}#) - #{body-exp\ 1127}# - (#{make-let\ 270}# - #{src\ 1123}# - #{ids\ 1124}# - #{vars\ 1125}# - #{val-exps\ 1126}# - #{body-exp\ 1127}#))))) - (#{build-named-let\ 334}# - (lambda (#{src\ 1133}# - #{ids\ 1134}# - #{vars\ 1135}# - #{val-exps\ 1136}# - #{body-exp\ 1137}#) + #{maybe-name-value! 298}# + #{ids 1124}# + #{val-exps 1126}#) + (if (null? #{vars 1125}#) + #{body-exp 1127}# + (#{make-let 270}# + #{src 1123}# + #{ids 1124}# + #{vars 1125}# + #{val-exps 1126}# + #{body-exp 1127}#))))) + (#{build-named-let 334}# + (lambda (#{src 1133}# + #{ids 1134}# + #{vars 1135}# + #{val-exps 1136}# + #{body-exp 1137}#) (begin - (let ((#{f\ 1147}# (car #{vars\ 1135}#)) - (#{f-name\ 1148}# (car #{ids\ 1134}#)) - (#{vars\ 1149}# (cdr #{vars\ 1135}#)) - (#{ids\ 1150}# (cdr #{ids\ 1134}#))) + (let ((#{f 1147}# (car #{vars 1135}#)) + (#{f-name 1148}# (car #{ids 1134}#)) + (#{vars 1149}# (cdr #{vars 1135}#)) + (#{ids 1150}# (cdr #{ids 1134}#))) (begin - (let ((#{proc\ 1152}# - (#{build-simple-lambda\ 320}# - #{src\ 1133}# - #{ids\ 1150}# + (let ((#{proc 1152}# + (#{build-simple-lambda 320}# + #{src 1133}# + #{ids 1150}# #f - #{vars\ 1149}# + #{vars 1149}# '() - #{body-exp\ 1137}#))) + #{body-exp 1137}#))) (begin - (#{maybe-name-value!\ 298}# - #{f-name\ 1148}# - #{proc\ 1152}#) + (#{maybe-name-value! 298}# + #{f-name 1148}# + #{proc 1152}#) (for-each - #{maybe-name-value!\ 298}# - #{ids\ 1150}# - #{val-exps\ 1136}#) - (#{make-letrec\ 272}# - #{src\ 1133}# + #{maybe-name-value! 298}# + #{ids 1150}# + #{val-exps 1136}#) + (#{make-letrec 272}# + #{src 1133}# #f - (list #{f-name\ 1148}#) - (list #{f\ 1147}#) - (list #{proc\ 1152}#) - (#{build-application\ 302}# - #{src\ 1133}# - (#{build-lexical-reference\ 308}# + (list #{f-name 1148}#) + (list #{f 1147}#) + (list #{proc 1152}#) + (#{build-application 302}# + #{src 1133}# + (#{build-lexical-reference 308}# 'fun - #{src\ 1133}# - #{f-name\ 1148}# - #{f\ 1147}#) - #{val-exps\ 1136}#))))))))) - (#{build-letrec\ 336}# - (lambda (#{src\ 1153}# - #{in-order?\ 1154}# - #{ids\ 1155}# - #{vars\ 1156}# - #{val-exps\ 1157}# - #{body-exp\ 1158}#) - (if (null? #{vars\ 1156}#) - #{body-exp\ 1158}# + #{src 1133}# + #{f-name 1148}# + #{f 1147}#) + #{val-exps 1136}#))))))))) + (#{build-letrec 336}# + (lambda (#{src 1153}# + #{in-order? 1154}# + #{ids 1155}# + #{vars 1156}# + #{val-exps 1157}# + #{body-exp 1158}#) + (if (null? #{vars 1156}#) + #{body-exp 1158}# (begin (for-each - #{maybe-name-value!\ 298}# - #{ids\ 1155}# - #{val-exps\ 1157}#) - (#{make-letrec\ 272}# - #{src\ 1153}# - #{in-order?\ 1154}# - #{ids\ 1155}# - #{vars\ 1156}# - #{val-exps\ 1157}# - #{body-exp\ 1158}#))))) - (#{make-syntax-object\ 340}# - (lambda (#{expression\ 1165}# - #{wrap\ 1166}# - #{module\ 1167}#) + #{maybe-name-value! 298}# + #{ids 1155}# + #{val-exps 1157}#) + (#{make-letrec 272}# + #{src 1153}# + #{in-order? 1154}# + #{ids 1155}# + #{vars 1156}# + #{val-exps 1157}# + #{body-exp 1158}#))))) + (#{make-syntax-object 340}# + (lambda (#{expression 1165}# + #{wrap 1166}# + #{module 1167}#) (vector 'syntax-object - #{expression\ 1165}# - #{wrap\ 1166}# - #{module\ 1167}#))) - (#{syntax-object?\ 342}# - (lambda (#{x\ 1171}#) - (if (vector? #{x\ 1171}#) - (if (= (vector-length #{x\ 1171}#) 4) - (eq? (vector-ref #{x\ 1171}# 0) 'syntax-object) + #{expression 1165}# + #{wrap 1166}# + #{module 1167}#))) + (#{syntax-object? 342}# + (lambda (#{x 1171}#) + (if (vector? #{x 1171}#) + (if (= (vector-length #{x 1171}#) 4) + (eq? (vector-ref #{x 1171}# 0) 'syntax-object) #f) #f))) - (#{syntax-object-expression\ 344}# - (lambda (#{x\ 1176}#) (vector-ref #{x\ 1176}# 1))) - (#{syntax-object-wrap\ 346}# - (lambda (#{x\ 1178}#) (vector-ref #{x\ 1178}# 2))) - (#{syntax-object-module\ 348}# - (lambda (#{x\ 1180}#) (vector-ref #{x\ 1180}# 3))) - (#{source-annotation\ 357}# - (lambda (#{x\ 1194}#) - (if (#{syntax-object?\ 342}# #{x\ 1194}#) - (#{source-annotation\ 357}# - (#{syntax-object-expression\ 344}# #{x\ 1194}#)) - (if (pair? #{x\ 1194}#) + (#{syntax-object-expression 344}# + (lambda (#{x 1176}#) (vector-ref #{x 1176}# 1))) + (#{syntax-object-wrap 346}# + (lambda (#{x 1178}#) (vector-ref #{x 1178}# 2))) + (#{syntax-object-module 348}# + (lambda (#{x 1180}#) (vector-ref #{x 1180}# 3))) + (#{source-annotation 357}# + (lambda (#{x 1194}#) + (if (#{syntax-object? 342}# #{x 1194}#) + (#{source-annotation 357}# + (#{syntax-object-expression 344}# #{x 1194}#)) + (if (pair? #{x 1194}#) (begin - (let ((#{props\ 1201}# (source-properties #{x\ 1194}#))) - (if (pair? #{props\ 1201}#) #{props\ 1201}# #f))) + (let ((#{props 1201}# (source-properties #{x 1194}#))) + (if (pair? #{props 1201}#) #{props 1201}# #f))) #f)))) - (#{extend-env\ 364}# - (lambda (#{labels\ 1203}# #{bindings\ 1204}# #{r\ 1205}#) - (if (null? #{labels\ 1203}#) - #{r\ 1205}# - (#{extend-env\ 364}# - (cdr #{labels\ 1203}#) - (cdr #{bindings\ 1204}#) - (cons (cons (car #{labels\ 1203}#) - (car #{bindings\ 1204}#)) - #{r\ 1205}#))))) - (#{extend-var-env\ 366}# - (lambda (#{labels\ 1209}# #{vars\ 1210}# #{r\ 1211}#) - (if (null? #{labels\ 1209}#) - #{r\ 1211}# - (#{extend-var-env\ 366}# - (cdr #{labels\ 1209}#) - (cdr #{vars\ 1210}#) - (cons (cons (car #{labels\ 1209}#) - (cons 'lexical (car #{vars\ 1210}#))) - #{r\ 1211}#))))) - (#{macros-only-env\ 368}# - (lambda (#{r\ 1216}#) - (if (null? #{r\ 1216}#) + (#{extend-env 364}# + (lambda (#{labels 1203}# #{bindings 1204}# #{r 1205}#) + (if (null? #{labels 1203}#) + #{r 1205}# + (#{extend-env 364}# + (cdr #{labels 1203}#) + (cdr #{bindings 1204}#) + (cons (cons (car #{labels 1203}#) + (car #{bindings 1204}#)) + #{r 1205}#))))) + (#{extend-var-env 366}# + (lambda (#{labels 1209}# #{vars 1210}# #{r 1211}#) + (if (null? #{labels 1209}#) + #{r 1211}# + (#{extend-var-env 366}# + (cdr #{labels 1209}#) + (cdr #{vars 1210}#) + (cons (cons (car #{labels 1209}#) + (cons 'lexical (car #{vars 1210}#))) + #{r 1211}#))))) + (#{macros-only-env 368}# + (lambda (#{r 1216}#) + (if (null? #{r 1216}#) '() (begin - (let ((#{a\ 1219}# (car #{r\ 1216}#))) - (if (eq? (car (cdr #{a\ 1219}#)) 'macro) - (cons #{a\ 1219}# - (#{macros-only-env\ 368}# (cdr #{r\ 1216}#))) - (#{macros-only-env\ 368}# (cdr #{r\ 1216}#)))))))) - (#{lookup\ 370}# - (lambda (#{x\ 1220}# #{r\ 1221}# #{mod\ 1222}#) + (let ((#{a 1219}# (car #{r 1216}#))) + (if (eq? (car (cdr #{a 1219}#)) 'macro) + (cons #{a 1219}# + (#{macros-only-env 368}# (cdr #{r 1216}#))) + (#{macros-only-env 368}# (cdr #{r 1216}#)))))))) + (#{lookup 370}# + (lambda (#{x 1220}# #{r 1221}# #{mod 1222}#) (begin - (let ((#{t\ 1228}# (assq #{x\ 1220}# #{r\ 1221}#))) - (if #{t\ 1228}# - (cdr #{t\ 1228}#) - (if (symbol? #{x\ 1220}#) + (let ((#{t 1228}# (assq #{x 1220}# #{r 1221}#))) + (if #{t 1228}# + (cdr #{t 1228}#) + (if (symbol? #{x 1220}#) (begin - (let ((#{t\ 1234}# - (#{get-global-definition-hook\ 294}# - #{x\ 1220}# - #{mod\ 1222}#))) - (if #{t\ 1234}# #{t\ 1234}# '(global)))) + (let ((#{t 1234}# + (#{get-global-definition-hook 294}# + #{x 1220}# + #{mod 1222}#))) + (if #{t 1234}# #{t 1234}# '(global)))) '(displaced-lexical))))))) - (#{global-extend\ 372}# - (lambda (#{type\ 1239}# #{sym\ 1240}# #{val\ 1241}#) - (#{put-global-definition-hook\ 292}# - #{sym\ 1240}# - #{type\ 1239}# - #{val\ 1241}#))) - (#{nonsymbol-id?\ 374}# - (lambda (#{x\ 1245}#) - (if (#{syntax-object?\ 342}# #{x\ 1245}#) + (#{global-extend 372}# + (lambda (#{type 1239}# #{sym 1240}# #{val 1241}#) + (#{put-global-definition-hook 292}# + #{sym 1240}# + #{type 1239}# + #{val 1241}#))) + (#{nonsymbol-id? 374}# + (lambda (#{x 1245}#) + (if (#{syntax-object? 342}# #{x 1245}#) (symbol? - (#{syntax-object-expression\ 344}# #{x\ 1245}#)) + (#{syntax-object-expression 344}# #{x 1245}#)) #f))) - (#{id?\ 376}# - (lambda (#{x\ 1249}#) - (if (symbol? #{x\ 1249}#) + (#{id? 376}# + (lambda (#{x 1249}#) + (if (symbol? #{x 1249}#) #t - (if (#{syntax-object?\ 342}# #{x\ 1249}#) + (if (#{syntax-object? 342}# #{x 1249}#) (symbol? - (#{syntax-object-expression\ 344}# #{x\ 1249}#)) + (#{syntax-object-expression 344}# #{x 1249}#)) #f)))) - (#{id-sym-name&marks\ 379}# - (lambda (#{x\ 1256}# #{w\ 1257}#) - (if (#{syntax-object?\ 342}# #{x\ 1256}#) + (#{id-sym-name&marks 379}# + (lambda (#{x 1256}# #{w 1257}#) + (if (#{syntax-object? 342}# #{x 1256}#) (values - (#{syntax-object-expression\ 344}# #{x\ 1256}#) - (#{join-marks\ 426}# - (car #{w\ 1257}#) - (car (#{syntax-object-wrap\ 346}# #{x\ 1256}#)))) - (values #{x\ 1256}# (car #{w\ 1257}#))))) - (#{gen-label\ 389}# + (#{syntax-object-expression 344}# #{x 1256}#) + (#{join-marks 426}# + (car #{w 1257}#) + (car (#{syntax-object-wrap 346}# #{x 1256}#)))) + (values #{x 1256}# (car #{w 1257}#))))) + (#{gen-label 389}# (lambda () (symbol->string (gensym "i")))) - (#{gen-labels\ 391}# - (lambda (#{ls\ 1263}#) - (if (null? #{ls\ 1263}#) + (#{gen-labels 391}# + (lambda (#{ls 1263}#) + (if (null? #{ls 1263}#) '() - (cons (#{gen-label\ 389}#) - (#{gen-labels\ 391}# (cdr #{ls\ 1263}#)))))) - (#{make-ribcage\ 394}# - (lambda (#{symnames\ 1265}# - #{marks\ 1266}# - #{labels\ 1267}#) + (cons (#{gen-label 389}#) + (#{gen-labels 391}# (cdr #{ls 1263}#)))))) + (#{make-ribcage 394}# + (lambda (#{symnames 1265}# + #{marks 1266}# + #{labels 1267}#) (vector 'ribcage - #{symnames\ 1265}# - #{marks\ 1266}# - #{labels\ 1267}#))) - (#{ribcage-symnames\ 398}# - (lambda (#{x\ 1276}#) (vector-ref #{x\ 1276}# 1))) - (#{ribcage-marks\ 400}# - (lambda (#{x\ 1278}#) (vector-ref #{x\ 1278}# 2))) - (#{ribcage-labels\ 402}# - (lambda (#{x\ 1280}#) (vector-ref #{x\ 1280}# 3))) - (#{set-ribcage-symnames!\ 404}# - (lambda (#{x\ 1282}# #{update\ 1283}#) - (vector-set! #{x\ 1282}# 1 #{update\ 1283}#))) - (#{set-ribcage-marks!\ 406}# - (lambda (#{x\ 1286}# #{update\ 1287}#) - (vector-set! #{x\ 1286}# 2 #{update\ 1287}#))) - (#{set-ribcage-labels!\ 408}# - (lambda (#{x\ 1290}# #{update\ 1291}#) - (vector-set! #{x\ 1290}# 3 #{update\ 1291}#))) - (#{anti-mark\ 414}# - (lambda (#{w\ 1294}#) - (cons (cons #f (car #{w\ 1294}#)) - (cons 'shift (cdr #{w\ 1294}#))))) - (#{extend-ribcage!\ 418}# - (lambda (#{ribcage\ 1300}# #{id\ 1301}# #{label\ 1302}#) + #{symnames 1265}# + #{marks 1266}# + #{labels 1267}#))) + (#{ribcage-symnames 398}# + (lambda (#{x 1276}#) (vector-ref #{x 1276}# 1))) + (#{ribcage-marks 400}# + (lambda (#{x 1278}#) (vector-ref #{x 1278}# 2))) + (#{ribcage-labels 402}# + (lambda (#{x 1280}#) (vector-ref #{x 1280}# 3))) + (#{set-ribcage-symnames! 404}# + (lambda (#{x 1282}# #{update 1283}#) + (vector-set! #{x 1282}# 1 #{update 1283}#))) + (#{set-ribcage-marks! 406}# + (lambda (#{x 1286}# #{update 1287}#) + (vector-set! #{x 1286}# 2 #{update 1287}#))) + (#{set-ribcage-labels! 408}# + (lambda (#{x 1290}# #{update 1291}#) + (vector-set! #{x 1290}# 3 #{update 1291}#))) + (#{anti-mark 414}# + (lambda (#{w 1294}#) + (cons (cons #f (car #{w 1294}#)) + (cons 'shift (cdr #{w 1294}#))))) + (#{extend-ribcage! 418}# + (lambda (#{ribcage 1300}# #{id 1301}# #{label 1302}#) (begin - (#{set-ribcage-symnames!\ 404}# - #{ribcage\ 1300}# - (cons (#{syntax-object-expression\ 344}# #{id\ 1301}#) - (#{ribcage-symnames\ 398}# #{ribcage\ 1300}#))) - (#{set-ribcage-marks!\ 406}# - #{ribcage\ 1300}# - (cons (car (#{syntax-object-wrap\ 346}# #{id\ 1301}#)) - (#{ribcage-marks\ 400}# #{ribcage\ 1300}#))) - (#{set-ribcage-labels!\ 408}# - #{ribcage\ 1300}# - (cons #{label\ 1302}# - (#{ribcage-labels\ 402}# #{ribcage\ 1300}#)))))) - (#{make-binding-wrap\ 420}# - (lambda (#{ids\ 1307}# #{labels\ 1308}# #{w\ 1309}#) - (if (null? #{ids\ 1307}#) - #{w\ 1309}# - (cons (car #{w\ 1309}#) + (#{set-ribcage-symnames! 404}# + #{ribcage 1300}# + (cons (#{syntax-object-expression 344}# #{id 1301}#) + (#{ribcage-symnames 398}# #{ribcage 1300}#))) + (#{set-ribcage-marks! 406}# + #{ribcage 1300}# + (cons (car (#{syntax-object-wrap 346}# #{id 1301}#)) + (#{ribcage-marks 400}# #{ribcage 1300}#))) + (#{set-ribcage-labels! 408}# + #{ribcage 1300}# + (cons #{label 1302}# + (#{ribcage-labels 402}# #{ribcage 1300}#)))))) + (#{make-binding-wrap 420}# + (lambda (#{ids 1307}# #{labels 1308}# #{w 1309}#) + (if (null? #{ids 1307}#) + #{w 1309}# + (cons (car #{w 1309}#) (cons (begin - (let ((#{labelvec\ 1316}# - (list->vector #{labels\ 1308}#))) + (let ((#{labelvec 1316}# + (list->vector #{labels 1308}#))) (begin - (let ((#{n\ 1318}# - (vector-length #{labelvec\ 1316}#))) + (let ((#{n 1318}# + (vector-length #{labelvec 1316}#))) (begin - (let ((#{symnamevec\ 1321}# - (make-vector #{n\ 1318}#)) - (#{marksvec\ 1322}# - (make-vector #{n\ 1318}#))) + (let ((#{symnamevec 1321}# + (make-vector #{n 1318}#)) + (#{marksvec 1322}# + (make-vector #{n 1318}#))) (begin (letrec* - ((#{f\ 1326}# - (lambda (#{ids\ 1327}# #{i\ 1328}#) - (if (not (null? #{ids\ 1327}#)) + ((#{f 1326}# + (lambda (#{ids 1327}# #{i 1328}#) + (if (not (null? #{ids 1327}#)) (call-with-values (lambda () - (#{id-sym-name&marks\ 379}# - (car #{ids\ 1327}#) - #{w\ 1309}#)) - (lambda (#{symname\ 1329}# - #{marks\ 1330}#) + (#{id-sym-name&marks 379}# + (car #{ids 1327}#) + #{w 1309}#)) + (lambda (#{symname 1329}# + #{marks 1330}#) (begin (vector-set! - #{symnamevec\ 1321}# - #{i\ 1328}# - #{symname\ 1329}#) + #{symnamevec 1321}# + #{i 1328}# + #{symname 1329}#) (vector-set! - #{marksvec\ 1322}# - #{i\ 1328}# - #{marks\ 1330}#) - (#{f\ 1326}# - (cdr #{ids\ 1327}#) - (1+ #{i\ 1328}#))))))))) - (begin (#{f\ 1326}# #{ids\ 1307}# 0))) - (#{make-ribcage\ 394}# - #{symnamevec\ 1321}# - #{marksvec\ 1322}# - #{labelvec\ 1316}#)))))))) - (cdr #{w\ 1309}#)))))) - (#{smart-append\ 422}# - (lambda (#{m1\ 1335}# #{m2\ 1336}#) - (if (null? #{m2\ 1336}#) - #{m1\ 1335}# - (append #{m1\ 1335}# #{m2\ 1336}#)))) - (#{join-wraps\ 424}# - (lambda (#{w1\ 1339}# #{w2\ 1340}#) + #{marksvec 1322}# + #{i 1328}# + #{marks 1330}#) + (#{f 1326}# + (cdr #{ids 1327}#) + (#{1+}# #{i 1328}#))))))))) + (begin (#{f 1326}# #{ids 1307}# 0))) + (#{make-ribcage 394}# + #{symnamevec 1321}# + #{marksvec 1322}# + #{labelvec 1316}#)))))))) + (cdr #{w 1309}#)))))) + (#{smart-append 422}# + (lambda (#{m1 1335}# #{m2 1336}#) + (if (null? #{m2 1336}#) + #{m1 1335}# + (append #{m1 1335}# #{m2 1336}#)))) + (#{join-wraps 424}# + (lambda (#{w1 1339}# #{w2 1340}#) (begin - (let ((#{m1\ 1345}# (car #{w1\ 1339}#)) - (#{s1\ 1346}# (cdr #{w1\ 1339}#))) - (if (null? #{m1\ 1345}#) - (if (null? #{s1\ 1346}#) - #{w2\ 1340}# - (cons (car #{w2\ 1340}#) - (#{smart-append\ 422}# - #{s1\ 1346}# - (cdr #{w2\ 1340}#)))) - (cons (#{smart-append\ 422}# - #{m1\ 1345}# - (car #{w2\ 1340}#)) - (#{smart-append\ 422}# - #{s1\ 1346}# - (cdr #{w2\ 1340}#)))))))) - (#{join-marks\ 426}# - (lambda (#{m1\ 1355}# #{m2\ 1356}#) - (#{smart-append\ 422}# #{m1\ 1355}# #{m2\ 1356}#))) - (#{same-marks?\ 428}# - (lambda (#{x\ 1359}# #{y\ 1360}#) + (let ((#{m1 1345}# (car #{w1 1339}#)) + (#{s1 1346}# (cdr #{w1 1339}#))) + (if (null? #{m1 1345}#) + (if (null? #{s1 1346}#) + #{w2 1340}# + (cons (car #{w2 1340}#) + (#{smart-append 422}# + #{s1 1346}# + (cdr #{w2 1340}#)))) + (cons (#{smart-append 422}# + #{m1 1345}# + (car #{w2 1340}#)) + (#{smart-append 422}# + #{s1 1346}# + (cdr #{w2 1340}#)))))))) + (#{join-marks 426}# + (lambda (#{m1 1355}# #{m2 1356}#) + (#{smart-append 422}# #{m1 1355}# #{m2 1356}#))) + (#{same-marks? 428}# + (lambda (#{x 1359}# #{y 1360}#) (begin - (let ((#{t\ 1365}# (eq? #{x\ 1359}# #{y\ 1360}#))) - (if #{t\ 1365}# - #{t\ 1365}# - (if (not (null? #{x\ 1359}#)) - (if (not (null? #{y\ 1360}#)) - (if (eq? (car #{x\ 1359}#) (car #{y\ 1360}#)) - (#{same-marks?\ 428}# - (cdr #{x\ 1359}#) - (cdr #{y\ 1360}#)) + (let ((#{t 1365}# (eq? #{x 1359}# #{y 1360}#))) + (if #{t 1365}# + #{t 1365}# + (if (not (null? #{x 1359}#)) + (if (not (null? #{y 1360}#)) + (if (eq? (car #{x 1359}#) (car #{y 1360}#)) + (#{same-marks? 428}# + (cdr #{x 1359}#) + (cdr #{y 1360}#)) #f) #f) #f)))))) - (#{id-var-name\ 430}# - (lambda (#{id\ 1371}# #{w\ 1372}#) + (#{id-var-name 430}# + (lambda (#{id 1371}# #{w 1372}#) (letrec* - ((#{search\ 1377}# - (lambda (#{sym\ 1393}# #{subst\ 1394}# #{marks\ 1395}#) - (if (null? #{subst\ 1394}#) - (values #f #{marks\ 1395}#) + ((#{search 1377}# + (lambda (#{sym 1393}# #{subst 1394}# #{marks 1395}#) + (if (null? #{subst 1394}#) + (values #f #{marks 1395}#) (begin - (let ((#{fst\ 1400}# (car #{subst\ 1394}#))) - (if (eq? #{fst\ 1400}# 'shift) - (#{search\ 1377}# - #{sym\ 1393}# - (cdr #{subst\ 1394}#) - (cdr #{marks\ 1395}#)) + (let ((#{fst 1400}# (car #{subst 1394}#))) + (if (eq? #{fst 1400}# 'shift) + (#{search 1377}# + #{sym 1393}# + (cdr #{subst 1394}#) + (cdr #{marks 1395}#)) (begin - (let ((#{symnames\ 1402}# - (#{ribcage-symnames\ 398}# #{fst\ 1400}#))) - (if (vector? #{symnames\ 1402}#) - (#{search-vector-rib\ 1381}# - #{sym\ 1393}# - #{subst\ 1394}# - #{marks\ 1395}# - #{symnames\ 1402}# - #{fst\ 1400}#) - (#{search-list-rib\ 1379}# - #{sym\ 1393}# - #{subst\ 1394}# - #{marks\ 1395}# - #{symnames\ 1402}# - #{fst\ 1400}#)))))))))) - (#{search-list-rib\ 1379}# - (lambda (#{sym\ 1403}# - #{subst\ 1404}# - #{marks\ 1405}# - #{symnames\ 1406}# - #{ribcage\ 1407}#) + (let ((#{symnames 1402}# + (#{ribcage-symnames 398}# #{fst 1400}#))) + (if (vector? #{symnames 1402}#) + (#{search-vector-rib 1381}# + #{sym 1393}# + #{subst 1394}# + #{marks 1395}# + #{symnames 1402}# + #{fst 1400}#) + (#{search-list-rib 1379}# + #{sym 1393}# + #{subst 1394}# + #{marks 1395}# + #{symnames 1402}# + #{fst 1400}#)))))))))) + (#{search-list-rib 1379}# + (lambda (#{sym 1403}# + #{subst 1404}# + #{marks 1405}# + #{symnames 1406}# + #{ribcage 1407}#) (letrec* - ((#{f\ 1416}# - (lambda (#{symnames\ 1417}# #{i\ 1418}#) - (if (null? #{symnames\ 1417}#) - (#{search\ 1377}# - #{sym\ 1403}# - (cdr #{subst\ 1404}#) - #{marks\ 1405}#) - (if (if (eq? (car #{symnames\ 1417}#) #{sym\ 1403}#) - (#{same-marks?\ 428}# - #{marks\ 1405}# + ((#{f 1416}# + (lambda (#{symnames 1417}# #{i 1418}#) + (if (null? #{symnames 1417}#) + (#{search 1377}# + #{sym 1403}# + (cdr #{subst 1404}#) + #{marks 1405}#) + (if (if (eq? (car #{symnames 1417}#) #{sym 1403}#) + (#{same-marks? 428}# + #{marks 1405}# (list-ref - (#{ribcage-marks\ 400}# #{ribcage\ 1407}#) - #{i\ 1418}#)) + (#{ribcage-marks 400}# #{ribcage 1407}#) + #{i 1418}#)) #f) (values (list-ref - (#{ribcage-labels\ 402}# #{ribcage\ 1407}#) - #{i\ 1418}#) - #{marks\ 1405}#) - (#{f\ 1416}# - (cdr #{symnames\ 1417}#) - (1+ #{i\ 1418}#))))))) - (begin (#{f\ 1416}# #{symnames\ 1406}# 0))))) - (#{search-vector-rib\ 1381}# - (lambda (#{sym\ 1427}# - #{subst\ 1428}# - #{marks\ 1429}# - #{symnames\ 1430}# - #{ribcage\ 1431}#) + (#{ribcage-labels 402}# #{ribcage 1407}#) + #{i 1418}#) + #{marks 1405}#) + (#{f 1416}# + (cdr #{symnames 1417}#) + (#{1+}# #{i 1418}#))))))) + (begin (#{f 1416}# #{symnames 1406}# 0))))) + (#{search-vector-rib 1381}# + (lambda (#{sym 1427}# + #{subst 1428}# + #{marks 1429}# + #{symnames 1430}# + #{ribcage 1431}#) (begin - (let ((#{n\ 1438}# (vector-length #{symnames\ 1430}#))) + (let ((#{n 1438}# (vector-length #{symnames 1430}#))) (letrec* - ((#{f\ 1441}# - (lambda (#{i\ 1442}#) - (if (= #{i\ 1442}# #{n\ 1438}#) - (#{search\ 1377}# - #{sym\ 1427}# - (cdr #{subst\ 1428}#) - #{marks\ 1429}#) + ((#{f 1441}# + (lambda (#{i 1442}#) + (if (= #{i 1442}# #{n 1438}#) + (#{search 1377}# + #{sym 1427}# + (cdr #{subst 1428}#) + #{marks 1429}#) (if (if (eq? (vector-ref - #{symnames\ 1430}# - #{i\ 1442}#) - #{sym\ 1427}#) - (#{same-marks?\ 428}# - #{marks\ 1429}# + #{symnames 1430}# + #{i 1442}#) + #{sym 1427}#) + (#{same-marks? 428}# + #{marks 1429}# (vector-ref - (#{ribcage-marks\ 400}# - #{ribcage\ 1431}#) - #{i\ 1442}#)) + (#{ribcage-marks 400}# + #{ribcage 1431}#) + #{i 1442}#)) #f) (values (vector-ref - (#{ribcage-labels\ 402}# - #{ribcage\ 1431}#) - #{i\ 1442}#) - #{marks\ 1429}#) - (#{f\ 1441}# (1+ #{i\ 1442}#))))))) - (begin (#{f\ 1441}# 0)))))))) + (#{ribcage-labels 402}# #{ribcage 1431}#) + #{i 1442}#) + #{marks 1429}#) + (#{f 1441}# (#{1+}# #{i 1442}#))))))) + (begin (#{f 1441}# 0)))))))) (begin - (if (symbol? #{id\ 1371}#) + (if (symbol? #{id 1371}#) (begin - (let ((#{t\ 1454}# + (let ((#{t 1454}# (call-with-values (lambda () - (#{search\ 1377}# - #{id\ 1371}# - (cdr #{w\ 1372}#) - (car #{w\ 1372}#))) - (lambda (#{x\ 1458}# . #{ignore\ 1459}#) - #{x\ 1458}#)))) - (if #{t\ 1454}# #{t\ 1454}# #{id\ 1371}#))) - (if (#{syntax-object?\ 342}# #{id\ 1371}#) + (#{search 1377}# + #{id 1371}# + (cdr #{w 1372}#) + (car #{w 1372}#))) + (lambda (#{x 1458}# . #{ignore 1459}#) + #{x 1458}#)))) + (if #{t 1454}# #{t 1454}# #{id 1371}#))) + (if (#{syntax-object? 342}# #{id 1371}#) (begin - (let ((#{id\ 1467}# - (#{syntax-object-expression\ 344}# #{id\ 1371}#)) - (#{w1\ 1468}# - (#{syntax-object-wrap\ 346}# #{id\ 1371}#))) + (let ((#{id 1467}# + (#{syntax-object-expression 344}# #{id 1371}#)) + (#{w1 1468}# + (#{syntax-object-wrap 346}# #{id 1371}#))) (begin - (let ((#{marks\ 1470}# - (#{join-marks\ 426}# - (car #{w\ 1372}#) - (car #{w1\ 1468}#)))) + (let ((#{marks 1470}# + (#{join-marks 426}# + (car #{w 1372}#) + (car #{w1 1468}#)))) (call-with-values (lambda () - (#{search\ 1377}# - #{id\ 1467}# - (cdr #{w\ 1372}#) - #{marks\ 1470}#)) - (lambda (#{new-id\ 1474}# #{marks\ 1475}#) + (#{search 1377}# + #{id 1467}# + (cdr #{w 1372}#) + #{marks 1470}#)) + (lambda (#{new-id 1474}# #{marks 1475}#) (begin - (let ((#{t\ 1480}# #{new-id\ 1474}#)) - (if #{t\ 1480}# - #{t\ 1480}# + (let ((#{t 1480}# #{new-id 1474}#)) + (if #{t 1480}# + #{t 1480}# (begin - (let ((#{t\ 1483}# + (let ((#{t 1483}# (call-with-values (lambda () - (#{search\ 1377}# - #{id\ 1467}# - (cdr #{w1\ 1468}#) - #{marks\ 1475}#)) - (lambda (#{x\ 1486}# + (#{search 1377}# + #{id 1467}# + (cdr #{w1 1468}#) + #{marks 1475}#)) + (lambda (#{x 1486}# . - #{ignore\ 1487}#) - #{x\ 1486}#)))) - (if #{t\ 1483}# - #{t\ 1483}# - #{id\ 1467}#)))))))))))) + #{ignore 1487}#) + #{x 1486}#)))) + (if #{t 1483}# + #{t 1483}# + #{id 1467}#)))))))))))) (syntax-violation 'id-var-name "invalid id" - #{id\ 1371}#))))))) - (#{free-id=?\ 432}# - (lambda (#{i\ 1492}# #{j\ 1493}#) + #{id 1371}#))))))) + (#{free-id=? 432}# + (lambda (#{i 1492}# #{j 1493}#) (if (eq? (begin - (let ((#{x\ 1499}# #{i\ 1492}#)) - (if (#{syntax-object?\ 342}# #{x\ 1499}#) - (#{syntax-object-expression\ 344}# #{x\ 1499}#) - #{x\ 1499}#))) + (let ((#{x 1499}# #{i 1492}#)) + (if (#{syntax-object? 342}# #{x 1499}#) + (#{syntax-object-expression 344}# #{x 1499}#) + #{x 1499}#))) (begin - (let ((#{x\ 1502}# #{j\ 1493}#)) - (if (#{syntax-object?\ 342}# #{x\ 1502}#) - (#{syntax-object-expression\ 344}# #{x\ 1502}#) - #{x\ 1502}#)))) - (eq? (#{id-var-name\ 430}# #{i\ 1492}# '(())) - (#{id-var-name\ 430}# #{j\ 1493}# '(()))) + (let ((#{x 1502}# #{j 1493}#)) + (if (#{syntax-object? 342}# #{x 1502}#) + (#{syntax-object-expression 344}# #{x 1502}#) + #{x 1502}#)))) + (eq? (#{id-var-name 430}# #{i 1492}# '(())) + (#{id-var-name 430}# #{j 1493}# '(()))) #f))) - (#{bound-id=?\ 434}# - (lambda (#{i\ 1506}# #{j\ 1507}#) - (if (if (#{syntax-object?\ 342}# #{i\ 1506}#) - (#{syntax-object?\ 342}# #{j\ 1507}#) + (#{bound-id=? 434}# + (lambda (#{i 1506}# #{j 1507}#) + (if (if (#{syntax-object? 342}# #{i 1506}#) + (#{syntax-object? 342}# #{j 1507}#) #f) - (if (eq? (#{syntax-object-expression\ 344}# #{i\ 1506}#) - (#{syntax-object-expression\ 344}# #{j\ 1507}#)) - (#{same-marks?\ 428}# - (car (#{syntax-object-wrap\ 346}# #{i\ 1506}#)) - (car (#{syntax-object-wrap\ 346}# #{j\ 1507}#))) + (if (eq? (#{syntax-object-expression 344}# #{i 1506}#) + (#{syntax-object-expression 344}# #{j 1507}#)) + (#{same-marks? 428}# + (car (#{syntax-object-wrap 346}# #{i 1506}#)) + (car (#{syntax-object-wrap 346}# #{j 1507}#))) #f) - (eq? #{i\ 1506}# #{j\ 1507}#)))) - (#{valid-bound-ids?\ 436}# - (lambda (#{ids\ 1516}#) + (eq? #{i 1506}# #{j 1507}#)))) + (#{valid-bound-ids? 436}# + (lambda (#{ids 1516}#) (if (letrec* - ((#{all-ids?\ 1521}# - (lambda (#{ids\ 1522}#) + ((#{all-ids? 1521}# + (lambda (#{ids 1522}#) (begin - (let ((#{t\ 1525}# (null? #{ids\ 1522}#))) - (if #{t\ 1525}# - #{t\ 1525}# - (if (#{id?\ 376}# (car #{ids\ 1522}#)) - (#{all-ids?\ 1521}# (cdr #{ids\ 1522}#)) + (let ((#{t 1525}# (null? #{ids 1522}#))) + (if #{t 1525}# + #{t 1525}# + (if (#{id? 376}# (car #{ids 1522}#)) + (#{all-ids? 1521}# (cdr #{ids 1522}#)) #f))))))) - (begin (#{all-ids?\ 1521}# #{ids\ 1516}#))) - (#{distinct-bound-ids?\ 438}# #{ids\ 1516}#) + (begin (#{all-ids? 1521}# #{ids 1516}#))) + (#{distinct-bound-ids? 438}# #{ids 1516}#) #f))) - (#{distinct-bound-ids?\ 438}# - (lambda (#{ids\ 1530}#) + (#{distinct-bound-ids? 438}# + (lambda (#{ids 1530}#) (letrec* - ((#{distinct?\ 1534}# - (lambda (#{ids\ 1535}#) + ((#{distinct? 1534}# + (lambda (#{ids 1535}#) (begin - (let ((#{t\ 1538}# (null? #{ids\ 1535}#))) - (if #{t\ 1538}# - #{t\ 1538}# - (if (not (#{bound-id-member?\ 440}# - (car #{ids\ 1535}#) - (cdr #{ids\ 1535}#))) - (#{distinct?\ 1534}# (cdr #{ids\ 1535}#)) + (let ((#{t 1538}# (null? #{ids 1535}#))) + (if #{t 1538}# + #{t 1538}# + (if (not (#{bound-id-member? 440}# + (car #{ids 1535}#) + (cdr #{ids 1535}#))) + (#{distinct? 1534}# (cdr #{ids 1535}#)) #f))))))) - (begin (#{distinct?\ 1534}# #{ids\ 1530}#))))) - (#{bound-id-member?\ 440}# - (lambda (#{x\ 1542}# #{list\ 1543}#) - (if (not (null? #{list\ 1543}#)) + (begin (#{distinct? 1534}# #{ids 1530}#))))) + (#{bound-id-member? 440}# + (lambda (#{x 1542}# #{list 1543}#) + (if (not (null? #{list 1543}#)) (begin - (let ((#{t\ 1550}# - (#{bound-id=?\ 434}# - #{x\ 1542}# - (car #{list\ 1543}#)))) - (if #{t\ 1550}# - #{t\ 1550}# - (#{bound-id-member?\ 440}# - #{x\ 1542}# - (cdr #{list\ 1543}#))))) + (let ((#{t 1550}# + (#{bound-id=? 434}# + #{x 1542}# + (car #{list 1543}#)))) + (if #{t 1550}# + #{t 1550}# + (#{bound-id-member? 440}# + #{x 1542}# + (cdr #{list 1543}#))))) #f))) - (#{wrap\ 442}# - (lambda (#{x\ 1552}# #{w\ 1553}# #{defmod\ 1554}#) - (if (if (null? (car #{w\ 1553}#)) - (null? (cdr #{w\ 1553}#)) + (#{wrap 442}# + (lambda (#{x 1552}# #{w 1553}# #{defmod 1554}#) + (if (if (null? (car #{w 1553}#)) + (null? (cdr #{w 1553}#)) #f) - #{x\ 1552}# - (if (#{syntax-object?\ 342}# #{x\ 1552}#) - (#{make-syntax-object\ 340}# - (#{syntax-object-expression\ 344}# #{x\ 1552}#) - (#{join-wraps\ 424}# - #{w\ 1553}# - (#{syntax-object-wrap\ 346}# #{x\ 1552}#)) - (#{syntax-object-module\ 348}# #{x\ 1552}#)) - (if (null? #{x\ 1552}#) - #{x\ 1552}# - (#{make-syntax-object\ 340}# - #{x\ 1552}# - #{w\ 1553}# - #{defmod\ 1554}#)))))) - (#{source-wrap\ 444}# - (lambda (#{x\ 1569}# - #{w\ 1570}# - #{s\ 1571}# - #{defmod\ 1572}#) - (#{wrap\ 442}# - (#{decorate-source\ 296}# - #{x\ 1569}# - #{s\ 1571}#) - #{w\ 1570}# - #{defmod\ 1572}#))) - (#{chi-sequence\ 446}# - (lambda (#{body\ 1577}# - #{r\ 1578}# - #{w\ 1579}# - #{s\ 1580}# - #{mod\ 1581}#) - (#{build-sequence\ 330}# - #{s\ 1580}# + #{x 1552}# + (if (#{syntax-object? 342}# #{x 1552}#) + (#{make-syntax-object 340}# + (#{syntax-object-expression 344}# #{x 1552}#) + (#{join-wraps 424}# + #{w 1553}# + (#{syntax-object-wrap 346}# #{x 1552}#)) + (#{syntax-object-module 348}# #{x 1552}#)) + (if (null? #{x 1552}#) + #{x 1552}# + (#{make-syntax-object 340}# + #{x 1552}# + #{w 1553}# + #{defmod 1554}#)))))) + (#{source-wrap 444}# + (lambda (#{x 1569}# + #{w 1570}# + #{s 1571}# + #{defmod 1572}#) + (#{wrap 442}# + (#{decorate-source 296}# #{x 1569}# #{s 1571}#) + #{w 1570}# + #{defmod 1572}#))) + (#{chi-sequence 446}# + (lambda (#{body 1577}# + #{r 1578}# + #{w 1579}# + #{s 1580}# + #{mod 1581}#) + (#{build-sequence 330}# + #{s 1580}# (letrec* - ((#{dobody\ 1592}# - (lambda (#{body\ 1593}# - #{r\ 1594}# - #{w\ 1595}# - #{mod\ 1596}#) - (if (null? #{body\ 1593}#) + ((#{dobody 1592}# + (lambda (#{body 1593}# + #{r 1594}# + #{w 1595}# + #{mod 1596}#) + (if (null? #{body 1593}#) '() (begin - (let ((#{first\ 1598}# - (#{chi\ 456}# - (car #{body\ 1593}#) - #{r\ 1594}# - #{w\ 1595}# - #{mod\ 1596}#))) - (cons #{first\ 1598}# - (#{dobody\ 1592}# - (cdr #{body\ 1593}#) - #{r\ 1594}# - #{w\ 1595}# - #{mod\ 1596}#)))))))) + (let ((#{first 1598}# + (#{chi 456}# + (car #{body 1593}#) + #{r 1594}# + #{w 1595}# + #{mod 1596}#))) + (cons #{first 1598}# + (#{dobody 1592}# + (cdr #{body 1593}#) + #{r 1594}# + #{w 1595}# + #{mod 1596}#)))))))) (begin - (#{dobody\ 1592}# - #{body\ 1577}# - #{r\ 1578}# - #{w\ 1579}# - #{mod\ 1581}#)))))) - (#{chi-top-sequence\ 448}# - (lambda (#{body\ 1599}# - #{r\ 1600}# - #{w\ 1601}# - #{s\ 1602}# - #{m\ 1603}# - #{esew\ 1604}# - #{mod\ 1605}#) + (#{dobody 1592}# + #{body 1577}# + #{r 1578}# + #{w 1579}# + #{mod 1581}#)))))) + (#{chi-top-sequence 448}# + (lambda (#{body 1599}# + #{r 1600}# + #{w 1601}# + #{s 1602}# + #{m 1603}# + #{esew 1604}# + #{mod 1605}#) (letrec* - ((#{scan\ 1614}# - (lambda (#{body\ 1615}# - #{r\ 1616}# - #{w\ 1617}# - #{s\ 1618}# - #{m\ 1619}# - #{esew\ 1620}# - #{mod\ 1621}# - #{exps\ 1622}#) - (if (null? #{body\ 1615}#) - #{exps\ 1622}# + ((#{scan 1614}# + (lambda (#{body 1615}# + #{r 1616}# + #{w 1617}# + #{s 1618}# + #{m 1619}# + #{esew 1620}# + #{mod 1621}# + #{exps 1622}#) + (if (null? #{body 1615}#) + #{exps 1622}# (call-with-values (lambda () (call-with-values (lambda () (begin - (let ((#{e\ 1635}# (car #{body\ 1615}#))) - (#{syntax-type\ 454}# - #{e\ 1635}# - #{r\ 1616}# - #{w\ 1617}# + (let ((#{e 1635}# (car #{body 1615}#))) + (#{syntax-type 454}# + #{e 1635}# + #{r 1616}# + #{w 1617}# (begin - (let ((#{t\ 1638}# - (#{source-annotation\ 357}# - #{e\ 1635}#))) - (if #{t\ 1638}# - #{t\ 1638}# - #{s\ 1618}#))) + (let ((#{t 1638}# + (#{source-annotation 357}# + #{e 1635}#))) + (if #{t 1638}# #{t 1638}# #{s 1618}#))) #f - #{mod\ 1621}# + #{mod 1621}# #f)))) - (lambda (#{type\ 1640}# - #{value\ 1641}# - #{e\ 1642}# - #{w\ 1643}# - #{s\ 1644}# - #{mod\ 1645}#) - (if (eqv? #{type\ 1640}# 'begin-form) - (let ((#{tmp\ 1653}# #{e\ 1642}#)) - (let ((#{tmp\ 1654}# - ($sc-dispatch #{tmp\ 1653}# '(_)))) - (if #{tmp\ 1654}# + (lambda (#{type 1640}# + #{value 1641}# + #{e 1642}# + #{w 1643}# + #{s 1644}# + #{mod 1645}#) + (if (eqv? #{type 1640}# 'begin-form) + (let ((#{tmp 1653}# #{e 1642}#)) + (let ((#{tmp 1654}# + ($sc-dispatch #{tmp 1653}# '(_)))) + (if #{tmp 1654}# (@apply - (lambda () #{exps\ 1622}#) - #{tmp\ 1654}#) - (let ((#{tmp\ 1655}# + (lambda () #{exps 1622}#) + #{tmp 1654}#) + (let ((#{tmp 1655}# ($sc-dispatch - #{tmp\ 1653}# + #{tmp 1653}# '(_ any . each-any)))) - (if #{tmp\ 1655}# + (if #{tmp 1655}# (@apply - (lambda (#{e1\ 1658}# #{e2\ 1659}#) - (#{scan\ 1614}# - (cons #{e1\ 1658}# #{e2\ 1659}#) - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# - #{m\ 1619}# - #{esew\ 1620}# - #{mod\ 1645}# - #{exps\ 1622}#)) - #{tmp\ 1655}#) + (lambda (#{e1 1658}# #{e2 1659}#) + (#{scan 1614}# + (cons #{e1 1658}# #{e2 1659}#) + #{r 1616}# + #{w 1643}# + #{s 1644}# + #{m 1619}# + #{esew 1620}# + #{mod 1645}# + #{exps 1622}#)) + #{tmp 1655}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1653}#)))))) - (if (eqv? #{type\ 1640}# 'local-syntax-form) - (#{chi-local-syntax\ 466}# - #{value\ 1641}# - #{e\ 1642}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# - #{mod\ 1645}# - (lambda (#{body\ 1662}# - #{r\ 1663}# - #{w\ 1664}# - #{s\ 1665}# - #{mod\ 1666}#) - (#{scan\ 1614}# - #{body\ 1662}# - #{r\ 1663}# - #{w\ 1664}# - #{s\ 1665}# - #{m\ 1619}# - #{esew\ 1620}# - #{mod\ 1666}# - #{exps\ 1622}#))) - (if (eqv? #{type\ 1640}# 'eval-when-form) - (let ((#{tmp\ 1673}# #{e\ 1642}#)) - (let ((#{tmp\ 1674}# + #{tmp 1653}#)))))) + (if (eqv? #{type 1640}# 'local-syntax-form) + (#{chi-local-syntax 466}# + #{value 1641}# + #{e 1642}# + #{r 1616}# + #{w 1643}# + #{s 1644}# + #{mod 1645}# + (lambda (#{body 1662}# + #{r 1663}# + #{w 1664}# + #{s 1665}# + #{mod 1666}#) + (#{scan 1614}# + #{body 1662}# + #{r 1663}# + #{w 1664}# + #{s 1665}# + #{m 1619}# + #{esew 1620}# + #{mod 1666}# + #{exps 1622}#))) + (if (eqv? #{type 1640}# 'eval-when-form) + (let ((#{tmp 1673}# #{e 1642}#)) + (let ((#{tmp 1674}# ($sc-dispatch - #{tmp\ 1673}# + #{tmp 1673}# '(_ each-any any . each-any)))) - (if #{tmp\ 1674}# + (if #{tmp 1674}# (@apply - (lambda (#{x\ 1678}# - #{e1\ 1679}# - #{e2\ 1680}#) + (lambda (#{x 1678}# + #{e1 1679}# + #{e2 1680}#) (begin - (let ((#{when-list\ 1683}# - (#{chi-when-list\ 452}# - #{e\ 1642}# - #{x\ 1678}# - #{w\ 1643}#)) - (#{body\ 1684}# - (cons #{e1\ 1679}# - #{e2\ 1680}#))) - (if (eq? #{m\ 1619}# 'e) + (let ((#{when-list 1683}# + (#{chi-when-list 452}# + #{e 1642}# + #{x 1678}# + #{w 1643}#)) + (#{body 1684}# + (cons #{e1 1679}# + #{e2 1680}#))) + (if (eq? #{m 1619}# 'e) (if (memq 'eval - #{when-list\ 1683}#) - (#{scan\ 1614}# - #{body\ 1684}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# + #{when-list 1683}#) + (#{scan 1614}# + #{body 1684}# + #{r 1616}# + #{w 1643}# + #{s 1644}# (if (memq 'expand - #{when-list\ 1683}#) + #{when-list 1683}#) 'c&e 'e) '(eval) - #{mod\ 1645}# - #{exps\ 1622}#) + #{mod 1645}# + #{exps 1622}#) (begin (if (memq 'expand - #{when-list\ 1683}#) - (#{top-level-eval-hook\ 287}# - (#{chi-top-sequence\ 448}# - #{body\ 1684}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# + #{when-list 1683}#) + (#{top-level-eval-hook 287}# + (#{chi-top-sequence 448}# + #{body 1684}# + #{r 1616}# + #{w 1643}# + #{s 1644}# 'e '(eval) - #{mod\ 1645}#) - #{mod\ 1645}#)) - #{exps\ 1622}#)) + #{mod 1645}#) + #{mod 1645}#)) + #{exps 1622}#)) (if (memq 'load - #{when-list\ 1683}#) + #{when-list 1683}#) (if (begin - (let ((#{t\ 1693}# + (let ((#{t 1693}# (memq 'compile - #{when-list\ 1683}#))) - (if #{t\ 1693}# - #{t\ 1693}# + #{when-list 1683}#))) + (if #{t 1693}# + #{t 1693}# (begin - (let ((#{t\ 1696}# + (let ((#{t 1696}# (memq 'expand - #{when-list\ 1683}#))) - (if #{t\ 1696}# - #{t\ 1696}# - (if (eq? #{m\ 1619}# + #{when-list 1683}#))) + (if #{t 1696}# + #{t 1696}# + (if (eq? #{m 1619}# 'c&e) (memq 'eval - #{when-list\ 1683}#) + #{when-list 1683}#) #f))))))) - (#{scan\ 1614}# - #{body\ 1684}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# + (#{scan 1614}# + #{body 1684}# + #{r 1616}# + #{w 1643}# + #{s 1644}# 'c&e '(compile load) - #{mod\ 1645}# - #{exps\ 1622}#) - (if (if (eq? #{m\ 1619}# + #{mod 1645}# + #{exps 1622}#) + (if (if (eq? #{m 1619}# 'c) #t - (eq? #{m\ 1619}# + (eq? #{m 1619}# 'c&e)) - (#{scan\ 1614}# - #{body\ 1684}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# + (#{scan 1614}# + #{body 1684}# + #{r 1616}# + #{w 1643}# + #{s 1644}# 'c '(load) - #{mod\ 1645}# - #{exps\ 1622}#) - #{exps\ 1622}#)) + #{mod 1645}# + #{exps 1622}#) + #{exps 1622}#)) (if (begin - (let ((#{t\ 1704}# + (let ((#{t 1704}# (memq 'compile - #{when-list\ 1683}#))) - (if #{t\ 1704}# - #{t\ 1704}# + #{when-list 1683}#))) + (if #{t 1704}# + #{t 1704}# (begin - (let ((#{t\ 1707}# + (let ((#{t 1707}# (memq 'expand - #{when-list\ 1683}#))) - (if #{t\ 1707}# - #{t\ 1707}# - (if (eq? #{m\ 1619}# + #{when-list 1683}#))) + (if #{t 1707}# + #{t 1707}# + (if (eq? #{m 1619}# 'c&e) (memq 'eval - #{when-list\ 1683}#) + #{when-list 1683}#) #f))))))) (begin - (#{top-level-eval-hook\ 287}# - (#{chi-top-sequence\ 448}# - #{body\ 1684}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# + (#{top-level-eval-hook 287}# + (#{chi-top-sequence 448}# + #{body 1684}# + #{r 1616}# + #{w 1643}# + #{s 1644}# 'e '(eval) - #{mod\ 1645}#) - #{mod\ 1645}#) - #{exps\ 1622}#) - #{exps\ 1622}#)))))) - #{tmp\ 1674}#) + #{mod 1645}#) + #{mod 1645}#) + #{exps 1622}#) + #{exps 1622}#)))))) + #{tmp 1674}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1673}#)))) - (if (eqv? #{type\ 1640}# 'define-syntax-form) + #{tmp 1673}#)))) + (if (eqv? #{type 1640}# 'define-syntax-form) (begin - (let ((#{n\ 1715}# - (#{id-var-name\ 430}# - #{value\ 1641}# - #{w\ 1643}#)) - (#{r\ 1716}# - (#{macros-only-env\ 368}# - #{r\ 1616}#))) - (if (eqv? #{m\ 1619}# 'c) - (if (memq 'compile #{esew\ 1620}#) + (let ((#{n 1715}# + (#{id-var-name 430}# + #{value 1641}# + #{w 1643}#)) + (#{r 1716}# + (#{macros-only-env 368}# + #{r 1616}#))) + (if (eqv? #{m 1619}# 'c) + (if (memq 'compile #{esew 1620}#) (begin - (let ((#{e\ 1719}# - (#{chi-install-global\ 450}# - #{n\ 1715}# - (#{chi\ 456}# - #{e\ 1642}# - #{r\ 1716}# - #{w\ 1643}# - #{mod\ 1645}#)))) + (let ((#{e 1719}# + (#{chi-install-global 450}# + #{n 1715}# + (#{chi 456}# + #{e 1642}# + #{r 1716}# + #{w 1643}# + #{mod 1645}#)))) (begin - (#{top-level-eval-hook\ 287}# - #{e\ 1719}# - #{mod\ 1645}#) + (#{top-level-eval-hook 287}# + #{e 1719}# + #{mod 1645}#) (if (memq 'load - #{esew\ 1620}#) - (cons #{e\ 1719}# - #{exps\ 1622}#) - #{exps\ 1622}#)))) - (if (memq 'load #{esew\ 1620}#) - (cons (#{chi-install-global\ 450}# - #{n\ 1715}# - (#{chi\ 456}# - #{e\ 1642}# - #{r\ 1716}# - #{w\ 1643}# - #{mod\ 1645}#)) - #{exps\ 1622}#) - #{exps\ 1622}#)) - (if (eqv? #{m\ 1619}# 'c&e) + #{esew 1620}#) + (cons #{e 1719}# + #{exps 1622}#) + #{exps 1622}#)))) + (if (memq 'load #{esew 1620}#) + (cons (#{chi-install-global 450}# + #{n 1715}# + (#{chi 456}# + #{e 1642}# + #{r 1716}# + #{w 1643}# + #{mod 1645}#)) + #{exps 1622}#) + #{exps 1622}#)) + (if (eqv? #{m 1619}# 'c&e) (begin - (let ((#{e\ 1722}# - (#{chi-install-global\ 450}# - #{n\ 1715}# - (#{chi\ 456}# - #{e\ 1642}# - #{r\ 1716}# - #{w\ 1643}# - #{mod\ 1645}#)))) + (let ((#{e 1722}# + (#{chi-install-global 450}# + #{n 1715}# + (#{chi 456}# + #{e 1642}# + #{r 1716}# + #{w 1643}# + #{mod 1645}#)))) (begin - (#{top-level-eval-hook\ 287}# - #{e\ 1722}# - #{mod\ 1645}#) - (cons #{e\ 1722}# - #{exps\ 1622}#)))) + (#{top-level-eval-hook 287}# + #{e 1722}# + #{mod 1645}#) + (cons #{e 1722}# + #{exps 1622}#)))) (begin - (if (memq 'eval #{esew\ 1620}#) - (#{top-level-eval-hook\ 287}# - (#{chi-install-global\ 450}# - #{n\ 1715}# - (#{chi\ 456}# - #{e\ 1642}# - #{r\ 1716}# - #{w\ 1643}# - #{mod\ 1645}#)) - #{mod\ 1645}#)) - #{exps\ 1622}#))))) - (if (eqv? #{type\ 1640}# 'define-form) + (if (memq 'eval #{esew 1620}#) + (#{top-level-eval-hook 287}# + (#{chi-install-global 450}# + #{n 1715}# + (#{chi 456}# + #{e 1642}# + #{r 1716}# + #{w 1643}# + #{mod 1645}#)) + #{mod 1645}#)) + #{exps 1622}#))))) + (if (eqv? #{type 1640}# 'define-form) (begin - (let ((#{n\ 1727}# - (#{id-var-name\ 430}# - #{value\ 1641}# - #{w\ 1643}#))) + (let ((#{n 1727}# + (#{id-var-name 430}# + #{value 1641}# + #{w 1643}#))) (begin - (let ((#{type\ 1729}# - (car (#{lookup\ 370}# - #{n\ 1727}# - #{r\ 1616}# - #{mod\ 1645}#)))) - (if (if (eqv? #{type\ 1729}# + (let ((#{type 1729}# + (car (#{lookup 370}# + #{n 1727}# + #{r 1616}# + #{mod 1645}#)))) + (if (if (eqv? #{type 1729}# 'global) #t - (if (eqv? #{type\ 1729}# + (if (eqv? #{type 1729}# 'core) #t - (if (eqv? #{type\ 1729}# + (if (eqv? #{type 1729}# 'macro) #t - (eqv? #{type\ 1729}# + (eqv? #{type 1729}# 'module-ref)))) (begin - (if (if (if (eq? #{m\ 1619}# + (if (if (if (eq? #{m 1619}# 'c) #t - (eq? #{m\ 1619}# + (eq? #{m 1619}# 'c&e)) (if (not (module-local-variable (current-module) - #{n\ 1727}#)) + #{n 1727}#)) (current-module) #f) #f) (begin - (let ((#{old\ 1736}# + (let ((#{old 1736}# (module-variable (current-module) - #{n\ 1727}#))) + #{n 1727}#))) (if (if (variable? - #{old\ 1736}#) + #{old 1736}#) (variable-bound? - #{old\ 1736}#) + #{old 1736}#) #f) (module-define! (current-module) - #{n\ 1727}# + #{n 1727}# (variable-ref - #{old\ 1736}#)) + #{old 1736}#)) (module-add! (current-module) - #{n\ 1727}# + #{n 1727}# (make-undefined-variable)))))) - (cons (if (eq? #{m\ 1619}# + (cons (if (eq? #{m 1619}# 'c&e) (begin - (let ((#{x\ 1740}# - (#{build-global-definition\ 318}# - #{s\ 1644}# - #{n\ 1727}# - (#{chi\ 456}# - #{e\ 1642}# - #{r\ 1616}# - #{w\ 1643}# - #{mod\ 1645}#)))) + (let ((#{x 1740}# + (#{build-global-definition 318}# + #{s 1644}# + #{n 1727}# + (#{chi 456}# + #{e 1642}# + #{r 1616}# + #{w 1643}# + #{mod 1645}#)))) (begin - (#{top-level-eval-hook\ 287}# - #{x\ 1740}# - #{mod\ 1645}#) - #{x\ 1740}#))) + (#{top-level-eval-hook 287}# + #{x 1740}# + #{mod 1645}#) + #{x 1740}#))) (lambda () - (#{build-global-definition\ 318}# - #{s\ 1644}# - #{n\ 1727}# - (#{chi\ 456}# - #{e\ 1642}# - #{r\ 1616}# - #{w\ 1643}# - #{mod\ 1645}#)))) - #{exps\ 1622}#)) - (if (eqv? #{type\ 1729}# + (#{build-global-definition 318}# + #{s 1644}# + #{n 1727}# + (#{chi 456}# + #{e 1642}# + #{r 1616}# + #{w 1643}# + #{mod 1645}#)))) + #{exps 1622}#)) + (if (eqv? #{type 1729}# 'displaced-lexical) (syntax-violation #f "identifier out of context" - #{e\ 1642}# - (#{wrap\ 442}# - #{value\ 1641}# - #{w\ 1643}# - #{mod\ 1645}#)) + #{e 1642}# + (#{wrap 442}# + #{value 1641}# + #{w 1643}# + #{mod 1645}#)) (syntax-violation #f "cannot define keyword at top level" - #{e\ 1642}# - (#{wrap\ 442}# - #{value\ 1641}# - #{w\ 1643}# - #{mod\ 1645}#)))))))) - (cons (if (eq? #{m\ 1619}# 'c&e) + #{e 1642}# + (#{wrap 442}# + #{value 1641}# + #{w 1643}# + #{mod 1645}#)))))))) + (cons (if (eq? #{m 1619}# 'c&e) (begin - (let ((#{x\ 1745}# - (#{chi-expr\ 458}# - #{type\ 1640}# - #{value\ 1641}# - #{e\ 1642}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# - #{mod\ 1645}#))) + (let ((#{x 1745}# + (#{chi-expr 458}# + #{type 1640}# + #{value 1641}# + #{e 1642}# + #{r 1616}# + #{w 1643}# + #{s 1644}# + #{mod 1645}#))) (begin - (#{top-level-eval-hook\ 287}# - #{x\ 1745}# - #{mod\ 1645}#) - #{x\ 1745}#))) + (#{top-level-eval-hook 287}# + #{x 1745}# + #{mod 1645}#) + #{x 1745}#))) (lambda () - (#{chi-expr\ 458}# - #{type\ 1640}# - #{value\ 1641}# - #{e\ 1642}# - #{r\ 1616}# - #{w\ 1643}# - #{s\ 1644}# - #{mod\ 1645}#))) - #{exps\ 1622}#))))))))) - (lambda (#{exps\ 1746}#) - (#{scan\ 1614}# - (cdr #{body\ 1615}#) - #{r\ 1616}# - #{w\ 1617}# - #{s\ 1618}# - #{m\ 1619}# - #{esew\ 1620}# - #{mod\ 1621}# - #{exps\ 1746}#))))))) + (#{chi-expr 458}# + #{type 1640}# + #{value 1641}# + #{e 1642}# + #{r 1616}# + #{w 1643}# + #{s 1644}# + #{mod 1645}#))) + #{exps 1622}#))))))))) + (lambda (#{exps 1746}#) + (#{scan 1614}# + (cdr #{body 1615}#) + #{r 1616}# + #{w 1617}# + #{s 1618}# + #{m 1619}# + #{esew 1620}# + #{mod 1621}# + #{exps 1746}#))))))) (begin (call-with-values (lambda () - (#{scan\ 1614}# - #{body\ 1599}# - #{r\ 1600}# - #{w\ 1601}# - #{s\ 1602}# - #{m\ 1603}# - #{esew\ 1604}# - #{mod\ 1605}# + (#{scan 1614}# + #{body 1599}# + #{r 1600}# + #{w 1601}# + #{s 1602}# + #{m 1603}# + #{esew 1604}# + #{mod 1605}# '())) - (lambda (#{exps\ 1748}#) - (if (null? #{exps\ 1748}#) - (#{build-void\ 300}# #{s\ 1602}#) - (#{build-sequence\ 330}# - #{s\ 1602}# + (lambda (#{exps 1748}#) + (if (null? #{exps 1748}#) + (#{build-void 300}# #{s 1602}#) + (#{build-sequence 330}# + #{s 1602}# (letrec* - ((#{lp\ 1753}# - (lambda (#{in\ 1754}# #{out\ 1755}#) - (if (null? #{in\ 1754}#) - #{out\ 1755}# + ((#{lp 1753}# + (lambda (#{in 1754}# #{out 1755}#) + (if (null? #{in 1754}#) + #{out 1755}# (begin - (let ((#{e\ 1757}# (car #{in\ 1754}#))) - (#{lp\ 1753}# - (cdr #{in\ 1754}#) - (cons (if (procedure? #{e\ 1757}#) - (#{e\ 1757}#) - #{e\ 1757}#) - #{out\ 1755}#)))))))) - (begin (#{lp\ 1753}# #{exps\ 1748}# '()))))))))))) - (#{chi-install-global\ 450}# - (lambda (#{name\ 1758}# #{e\ 1759}#) - (#{build-global-definition\ 318}# + (let ((#{e 1757}# (car #{in 1754}#))) + (#{lp 1753}# + (cdr #{in 1754}#) + (cons (if (procedure? #{e 1757}#) + (#{e 1757}#) + #{e 1757}#) + #{out 1755}#)))))))) + (begin (#{lp 1753}# #{exps 1748}# '()))))))))))) + (#{chi-install-global 450}# + (lambda (#{name 1758}# #{e 1759}#) + (#{build-global-definition 318}# #f - #{name\ 1758}# - (#{build-application\ 302}# + #{name 1758}# + (#{build-application 302}# #f - (#{build-primref\ 326}# + (#{build-primref 326}# #f 'make-syntax-transformer) - (list (#{build-data\ 328}# #f #{name\ 1758}#) - (#{build-data\ 328}# #f 'macro) - #{e\ 1759}#))))) - (#{chi-when-list\ 452}# - (lambda (#{e\ 1767}# #{when-list\ 1768}# #{w\ 1769}#) + (list (#{build-data 328}# #f #{name 1758}#) + (#{build-data 328}# #f 'macro) + #{e 1759}#))))) + (#{chi-when-list 452}# + (lambda (#{e 1767}# #{when-list 1768}# #{w 1769}#) (letrec* - ((#{f\ 1776}# - (lambda (#{when-list\ 1777}# #{situations\ 1778}#) - (if (null? #{when-list\ 1777}#) - #{situations\ 1778}# - (#{f\ 1776}# - (cdr #{when-list\ 1777}#) + ((#{f 1776}# + (lambda (#{when-list 1777}# #{situations 1778}#) + (if (null? #{when-list 1777}#) + #{situations 1778}# + (#{f 1776}# + (cdr #{when-list 1777}#) (cons (begin - (let ((#{x\ 1780}# (car #{when-list\ 1777}#))) - (if (#{free-id=?\ 432}# - #{x\ 1780}# + (let ((#{x 1780}# (car #{when-list 1777}#))) + (if (#{free-id=? 432}# + #{x 1780}# '#(syntax-object compile ((top) @@ -2010,8 +2002,8 @@ ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'compile - (if (#{free-id=?\ 432}# - #{x\ 1780}# + (if (#{free-id=? 432}# + #{x 1780}# '#(syntax-object load ((top) @@ -2447,8 +2439,8 @@ ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'load - (if (#{free-id=?\ 432}# - #{x\ 1780}# + (if (#{free-id=? 432}# + #{x 1780}# '#(syntax-object eval ((top) @@ -2887,8 +2879,8 @@ ("i41" "i40" "i39" "i37"))) (hygiene guile))) 'eval - (if (#{free-id=?\ 432}# - #{x\ 1780}# + (if (#{free-id=? 432}# + #{x 1780}# '#(syntax-object expand ((top) @@ -3330,244 +3322,244 @@ (syntax-violation 'eval-when "invalid situation" - #{e\ 1767}# - (#{wrap\ 442}# - #{x\ 1780}# - #{w\ 1769}# + #{e 1767}# + (#{wrap 442}# + #{x 1780}# + #{w 1769}# #f)))))))) - #{situations\ 1778}#)))))) - (begin (#{f\ 1776}# #{when-list\ 1768}# '()))))) - (#{syntax-type\ 454}# - (lambda (#{e\ 1790}# - #{r\ 1791}# - #{w\ 1792}# - #{s\ 1793}# - #{rib\ 1794}# - #{mod\ 1795}# - #{for-car?\ 1796}#) - (if (symbol? #{e\ 1790}#) + #{situations 1778}#)))))) + (begin (#{f 1776}# #{when-list 1768}# '()))))) + (#{syntax-type 454}# + (lambda (#{e 1790}# + #{r 1791}# + #{w 1792}# + #{s 1793}# + #{rib 1794}# + #{mod 1795}# + #{for-car? 1796}#) + (if (symbol? #{e 1790}#) (begin - (let ((#{n\ 1808}# - (#{id-var-name\ 430}# #{e\ 1790}# #{w\ 1792}#))) + (let ((#{n 1808}# + (#{id-var-name 430}# #{e 1790}# #{w 1792}#))) (begin - (let ((#{b\ 1810}# - (#{lookup\ 370}# - #{n\ 1808}# - #{r\ 1791}# - #{mod\ 1795}#))) + (let ((#{b 1810}# + (#{lookup 370}# + #{n 1808}# + #{r 1791}# + #{mod 1795}#))) (begin - (let ((#{type\ 1812}# (car #{b\ 1810}#))) - (if (eqv? #{type\ 1812}# 'lexical) + (let ((#{type 1812}# (car #{b 1810}#))) + (if (eqv? #{type 1812}# 'lexical) (values - #{type\ 1812}# - (cdr #{b\ 1810}#) - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{type\ 1812}# 'global) + #{type 1812}# + (cdr #{b 1810}#) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{type 1812}# 'global) (values - #{type\ 1812}# - #{n\ 1808}# - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{type\ 1812}# 'macro) - (if #{for-car?\ 1796}# + #{type 1812}# + #{n 1808}# + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{type 1812}# 'macro) + (if #{for-car? 1796}# (values - #{type\ 1812}# - (cdr #{b\ 1810}#) - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (#{syntax-type\ 454}# - (#{chi-macro\ 462}# - (cdr #{b\ 1810}#) - #{e\ 1790}# - #{r\ 1791}# - #{w\ 1792}# - #{s\ 1793}# - #{rib\ 1794}# - #{mod\ 1795}#) - #{r\ 1791}# + #{type 1812}# + (cdr #{b 1810}#) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (#{syntax-type 454}# + (#{chi-macro 462}# + (cdr #{b 1810}#) + #{e 1790}# + #{r 1791}# + #{w 1792}# + #{s 1793}# + #{rib 1794}# + #{mod 1795}#) + #{r 1791}# '(()) - #{s\ 1793}# - #{rib\ 1794}# - #{mod\ 1795}# + #{s 1793}# + #{rib 1794}# + #{mod 1795}# #f)) (values - #{type\ 1812}# - (cdr #{b\ 1810}#) - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#)))))))))) - (if (pair? #{e\ 1790}#) + #{type 1812}# + (cdr #{b 1810}#) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#)))))))))) + (if (pair? #{e 1790}#) (begin - (let ((#{first\ 1826}# (car #{e\ 1790}#))) + (let ((#{first 1826}# (car #{e 1790}#))) (call-with-values (lambda () - (#{syntax-type\ 454}# - #{first\ 1826}# - #{r\ 1791}# - #{w\ 1792}# - #{s\ 1793}# - #{rib\ 1794}# - #{mod\ 1795}# + (#{syntax-type 454}# + #{first 1826}# + #{r 1791}# + #{w 1792}# + #{s 1793}# + #{rib 1794}# + #{mod 1795}# #t)) - (lambda (#{ftype\ 1827}# - #{fval\ 1828}# - #{fe\ 1829}# - #{fw\ 1830}# - #{fs\ 1831}# - #{fmod\ 1832}#) - (if (eqv? #{ftype\ 1827}# 'lexical) + (lambda (#{ftype 1827}# + #{fval 1828}# + #{fe 1829}# + #{fw 1830}# + #{fs 1831}# + #{fmod 1832}#) + (if (eqv? #{ftype 1827}# 'lexical) (values 'lexical-call - #{fval\ 1828}# - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{ftype\ 1827}# 'global) + #{fval 1828}# + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{ftype 1827}# 'global) (values 'global-call - (#{make-syntax-object\ 340}# - #{fval\ 1828}# - #{w\ 1792}# - #{fmod\ 1832}#) - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{ftype\ 1827}# 'macro) - (#{syntax-type\ 454}# - (#{chi-macro\ 462}# - #{fval\ 1828}# - #{e\ 1790}# - #{r\ 1791}# - #{w\ 1792}# - #{s\ 1793}# - #{rib\ 1794}# - #{mod\ 1795}#) - #{r\ 1791}# + (#{make-syntax-object 340}# + #{fval 1828}# + #{w 1792}# + #{fmod 1832}#) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{ftype 1827}# 'macro) + (#{syntax-type 454}# + (#{chi-macro 462}# + #{fval 1828}# + #{e 1790}# + #{r 1791}# + #{w 1792}# + #{s 1793}# + #{rib 1794}# + #{mod 1795}#) + #{r 1791}# '(()) - #{s\ 1793}# - #{rib\ 1794}# - #{mod\ 1795}# - #{for-car?\ 1796}#) - (if (eqv? #{ftype\ 1827}# 'module-ref) + #{s 1793}# + #{rib 1794}# + #{mod 1795}# + #{for-car? 1796}#) + (if (eqv? #{ftype 1827}# 'module-ref) (call-with-values (lambda () - (#{fval\ 1828}# - #{e\ 1790}# - #{r\ 1791}# - #{w\ 1792}#)) - (lambda (#{e\ 1844}# - #{r\ 1845}# - #{w\ 1846}# - #{s\ 1847}# - #{mod\ 1848}#) - (#{syntax-type\ 454}# - #{e\ 1844}# - #{r\ 1845}# - #{w\ 1846}# - #{s\ 1847}# - #{rib\ 1794}# - #{mod\ 1848}# - #{for-car?\ 1796}#))) - (if (eqv? #{ftype\ 1827}# 'core) + (#{fval 1828}# + #{e 1790}# + #{r 1791}# + #{w 1792}#)) + (lambda (#{e 1844}# + #{r 1845}# + #{w 1846}# + #{s 1847}# + #{mod 1848}#) + (#{syntax-type 454}# + #{e 1844}# + #{r 1845}# + #{w 1846}# + #{s 1847}# + #{rib 1794}# + #{mod 1848}# + #{for-car? 1796}#))) + (if (eqv? #{ftype 1827}# 'core) (values 'core-form - #{fval\ 1828}# - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{ftype\ 1827}# 'local-syntax) + #{fval 1828}# + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{ftype 1827}# 'local-syntax) (values 'local-syntax-form - #{fval\ 1828}# - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{ftype\ 1827}# 'begin) + #{fval 1828}# + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{ftype 1827}# 'begin) (values 'begin-form #f - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{ftype\ 1827}# 'eval-when) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{ftype 1827}# 'eval-when) (values 'eval-when-form #f - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) - (if (eqv? #{ftype\ 1827}# 'define) - (let ((#{tmp\ 1859}# #{e\ 1790}#)) - (let ((#{tmp\ 1860}# + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) + (if (eqv? #{ftype 1827}# 'define) + (let ((#{tmp 1859}# #{e 1790}#)) + (let ((#{tmp 1860}# ($sc-dispatch - #{tmp\ 1859}# + #{tmp 1859}# '(_ any any)))) - (if (if #{tmp\ 1860}# + (if (if #{tmp 1860}# (@apply - (lambda (#{name\ 1863}# - #{val\ 1864}#) - (#{id?\ 376}# - #{name\ 1863}#)) - #{tmp\ 1860}#) + (lambda (#{name 1863}# + #{val 1864}#) + (#{id? 376}# + #{name 1863}#)) + #{tmp 1860}#) #f) (@apply - (lambda (#{name\ 1867}# - #{val\ 1868}#) + (lambda (#{name 1867}# + #{val 1868}#) (values 'define-form - #{name\ 1867}# - #{val\ 1868}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#)) - #{tmp\ 1860}#) - (let ((#{tmp\ 1869}# + #{name 1867}# + #{val 1868}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#)) + #{tmp 1860}#) + (let ((#{tmp 1869}# ($sc-dispatch - #{tmp\ 1859}# + #{tmp 1859}# '(_ (any . any) any . each-any)))) - (if (if #{tmp\ 1869}# + (if (if #{tmp 1869}# (@apply - (lambda (#{name\ 1874}# - #{args\ 1875}# - #{e1\ 1876}# - #{e2\ 1877}#) - (if (#{id?\ 376}# - #{name\ 1874}#) - (#{valid-bound-ids?\ 436}# - (#{lambda-var-list\ 486}# - #{args\ 1875}#)) + (lambda (#{name 1874}# + #{args 1875}# + #{e1 1876}# + #{e2 1877}#) + (if (#{id? 376}# + #{name 1874}#) + (#{valid-bound-ids? 436}# + (#{lambda-var-list 486}# + #{args 1875}#)) #f)) - #{tmp\ 1869}#) + #{tmp 1869}#) #f) (@apply - (lambda (#{name\ 1884}# - #{args\ 1885}# - #{e1\ 1886}# - #{e2\ 1887}#) + (lambda (#{name 1884}# + #{args 1885}# + #{e1 1886}# + #{e2 1887}#) (values 'define-form - (#{wrap\ 442}# - #{name\ 1884}# - #{w\ 1792}# - #{mod\ 1795}#) - (#{decorate-source\ 296}# + (#{wrap 442}# + #{name 1884}# + #{w 1792}# + #{mod 1795}#) + (#{decorate-source 296}# (cons '#(syntax-object lambda ((top) @@ -4077,36 +4069,36 @@ "i37"))) (hygiene guile)) - (#{wrap\ 442}# - (cons #{args\ 1885}# - (cons #{e1\ 1886}# - #{e2\ 1887}#)) - #{w\ 1792}# - #{mod\ 1795}#)) - #{s\ 1793}#) + (#{wrap 442}# + (cons #{args 1885}# + (cons #{e1 1886}# + #{e2 1887}#)) + #{w 1792}# + #{mod 1795}#)) + #{s 1793}#) '(()) - #{s\ 1793}# - #{mod\ 1795}#)) - #{tmp\ 1869}#) - (let ((#{tmp\ 1890}# + #{s 1793}# + #{mod 1795}#)) + #{tmp 1869}#) + (let ((#{tmp 1890}# ($sc-dispatch - #{tmp\ 1859}# + #{tmp 1859}# '(_ any)))) - (if (if #{tmp\ 1890}# + (if (if #{tmp 1890}# (@apply - (lambda (#{name\ 1892}#) - (#{id?\ 376}# - #{name\ 1892}#)) - #{tmp\ 1890}#) + (lambda (#{name 1892}#) + (#{id? 376}# + #{name 1892}#)) + #{tmp 1890}#) #f) (@apply - (lambda (#{name\ 1894}#) + (lambda (#{name 1894}#) (values 'define-form - (#{wrap\ 442}# - #{name\ 1894}# - #{w\ 1792}# - #{mod\ 1795}#) + (#{wrap 442}# + #{name 1894}# + #{w 1792}# + #{mod 1795}#) '(#(syntax-object if ((top) @@ -5608,840 +5600,828 @@ (hygiene guile))) '(()) - #{s\ 1793}# - #{mod\ 1795}#)) - #{tmp\ 1890}#) + #{s 1793}# + #{mod 1795}#)) + #{tmp 1890}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1859}#)))))))) - (if (eqv? #{ftype\ 1827}# + #{tmp 1859}#)))))))) + (if (eqv? #{ftype 1827}# 'define-syntax) - (let ((#{tmp\ 1897}# #{e\ 1790}#)) - (let ((#{tmp\ 1898}# + (let ((#{tmp 1897}# #{e 1790}#)) + (let ((#{tmp 1898}# ($sc-dispatch - #{tmp\ 1897}# + #{tmp 1897}# '(_ any any)))) - (if (if #{tmp\ 1898}# + (if (if #{tmp 1898}# (@apply - (lambda (#{name\ 1901}# - #{val\ 1902}#) - (#{id?\ 376}# - #{name\ 1901}#)) - #{tmp\ 1898}#) + (lambda (#{name 1901}# + #{val 1902}#) + (#{id? 376}# + #{name 1901}#)) + #{tmp 1898}#) #f) (@apply - (lambda (#{name\ 1905}# - #{val\ 1906}#) + (lambda (#{name 1905}# + #{val 1906}#) (values 'define-syntax-form - #{name\ 1905}# - #{val\ 1906}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#)) - #{tmp\ 1898}#) + #{name 1905}# + #{val 1906}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#)) + #{tmp 1898}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1897}#)))) + #{tmp 1897}#)))) (values 'call #f - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#))))))))))))))) - (if (#{syntax-object?\ 342}# #{e\ 1790}#) - (#{syntax-type\ 454}# - (#{syntax-object-expression\ 344}# #{e\ 1790}#) - #{r\ 1791}# - (#{join-wraps\ 424}# - #{w\ 1792}# - (#{syntax-object-wrap\ 346}# #{e\ 1790}#)) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#))))))))))))))) + (if (#{syntax-object? 342}# #{e 1790}#) + (#{syntax-type 454}# + (#{syntax-object-expression 344}# #{e 1790}#) + #{r 1791}# + (#{join-wraps 424}# + #{w 1792}# + (#{syntax-object-wrap 346}# #{e 1790}#)) (begin - (let ((#{t\ 1912}# - (#{source-annotation\ 357}# #{e\ 1790}#))) - (if #{t\ 1912}# #{t\ 1912}# #{s\ 1793}#))) - #{rib\ 1794}# + (let ((#{t 1912}# + (#{source-annotation 357}# #{e 1790}#))) + (if #{t 1912}# #{t 1912}# #{s 1793}#))) + #{rib 1794}# (begin - (let ((#{t\ 1916}# - (#{syntax-object-module\ 348}# #{e\ 1790}#))) - (if #{t\ 1916}# #{t\ 1916}# #{mod\ 1795}#))) - #{for-car?\ 1796}#) - (if (self-evaluating? #{e\ 1790}#) + (let ((#{t 1916}# + (#{syntax-object-module 348}# #{e 1790}#))) + (if #{t 1916}# #{t 1916}# #{mod 1795}#))) + #{for-car? 1796}#) + (if (self-evaluating? #{e 1790}#) (values 'constant #f - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#) (values 'other #f - #{e\ 1790}# - #{w\ 1792}# - #{s\ 1793}# - #{mod\ 1795}#))))))) - (#{chi\ 456}# - (lambda (#{e\ 1921}# - #{r\ 1922}# - #{w\ 1923}# - #{mod\ 1924}#) + #{e 1790}# + #{w 1792}# + #{s 1793}# + #{mod 1795}#))))))) + (#{chi 456}# + (lambda (#{e 1921}# #{r 1922}# #{w 1923}# #{mod 1924}#) (call-with-values (lambda () - (#{syntax-type\ 454}# - #{e\ 1921}# - #{r\ 1922}# - #{w\ 1923}# - (#{source-annotation\ 357}# #{e\ 1921}#) + (#{syntax-type 454}# + #{e 1921}# + #{r 1922}# + #{w 1923}# + (#{source-annotation 357}# #{e 1921}#) #f - #{mod\ 1924}# + #{mod 1924}# #f)) - (lambda (#{type\ 1929}# - #{value\ 1930}# - #{e\ 1931}# - #{w\ 1932}# - #{s\ 1933}# - #{mod\ 1934}#) - (#{chi-expr\ 458}# - #{type\ 1929}# - #{value\ 1930}# - #{e\ 1931}# - #{r\ 1922}# - #{w\ 1932}# - #{s\ 1933}# - #{mod\ 1934}#))))) - (#{chi-expr\ 458}# - (lambda (#{type\ 1941}# - #{value\ 1942}# - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) - (if (eqv? #{type\ 1941}# 'lexical) - (#{build-lexical-reference\ 308}# + (lambda (#{type 1929}# + #{value 1930}# + #{e 1931}# + #{w 1932}# + #{s 1933}# + #{mod 1934}#) + (#{chi-expr 458}# + #{type 1929}# + #{value 1930}# + #{e 1931}# + #{r 1922}# + #{w 1932}# + #{s 1933}# + #{mod 1934}#))))) + (#{chi-expr 458}# + (lambda (#{type 1941}# + #{value 1942}# + #{e 1943}# + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) + (if (eqv? #{type 1941}# 'lexical) + (#{build-lexical-reference 308}# 'value - #{s\ 1946}# - #{e\ 1943}# - #{value\ 1942}#) - (if (if (eqv? #{type\ 1941}# 'core) + #{s 1946}# + #{e 1943}# + #{value 1942}#) + (if (if (eqv? #{type 1941}# 'core) #t - (eqv? #{type\ 1941}# 'core-form)) - (#{value\ 1942}# - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) - (if (eqv? #{type\ 1941}# 'module-ref) + (eqv? #{type 1941}# 'core-form)) + (#{value 1942}# + #{e 1943}# + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) + (if (eqv? #{type 1941}# 'module-ref) (call-with-values (lambda () - (#{value\ 1942}# - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}#)) - (lambda (#{e\ 1958}# - #{r\ 1959}# - #{w\ 1960}# - #{s\ 1961}# - #{mod\ 1962}#) - (#{chi\ 456}# - #{e\ 1958}# - #{r\ 1959}# - #{w\ 1960}# - #{mod\ 1962}#))) - (if (eqv? #{type\ 1941}# 'lexical-call) - (#{chi-application\ 460}# + (#{value 1942}# #{e 1943}# #{r 1944}# #{w 1945}#)) + (lambda (#{e 1958}# + #{r 1959}# + #{w 1960}# + #{s 1961}# + #{mod 1962}#) + (#{chi 456}# + #{e 1958}# + #{r 1959}# + #{w 1960}# + #{mod 1962}#))) + (if (eqv? #{type 1941}# 'lexical-call) + (#{chi-application 460}# (begin - (let ((#{id\ 1970}# (car #{e\ 1943}#))) - (#{build-lexical-reference\ 308}# + (let ((#{id 1970}# (car #{e 1943}#))) + (#{build-lexical-reference 308}# 'fun - (#{source-annotation\ 357}# #{id\ 1970}#) - (if (#{syntax-object?\ 342}# #{id\ 1970}#) - (syntax->datum #{id\ 1970}#) - #{id\ 1970}#) - #{value\ 1942}#))) - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) - (if (eqv? #{type\ 1941}# 'global-call) - (#{chi-application\ 460}# - (#{build-global-reference\ 314}# - (#{source-annotation\ 357}# (car #{e\ 1943}#)) - (if (#{syntax-object?\ 342}# #{value\ 1942}#) - (#{syntax-object-expression\ 344}# - #{value\ 1942}#) - #{value\ 1942}#) - (if (#{syntax-object?\ 342}# #{value\ 1942}#) - (#{syntax-object-module\ 348}# #{value\ 1942}#) - #{mod\ 1947}#)) - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) - (if (eqv? #{type\ 1941}# 'constant) - (#{build-data\ 328}# - #{s\ 1946}# - (#{strip\ 482}# - (#{source-wrap\ 444}# - #{e\ 1943}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) + (#{source-annotation 357}# #{id 1970}#) + (if (#{syntax-object? 342}# #{id 1970}#) + (syntax->datum #{id 1970}#) + #{id 1970}#) + #{value 1942}#))) + #{e 1943}# + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) + (if (eqv? #{type 1941}# 'global-call) + (#{chi-application 460}# + (#{build-global-reference 314}# + (#{source-annotation 357}# (car #{e 1943}#)) + (if (#{syntax-object? 342}# #{value 1942}#) + (#{syntax-object-expression 344}# #{value 1942}#) + #{value 1942}#) + (if (#{syntax-object? 342}# #{value 1942}#) + (#{syntax-object-module 348}# #{value 1942}#) + #{mod 1947}#)) + #{e 1943}# + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) + (if (eqv? #{type 1941}# 'constant) + (#{build-data 328}# + #{s 1946}# + (#{strip 482}# + (#{source-wrap 444}# + #{e 1943}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) '(()))) - (if (eqv? #{type\ 1941}# 'global) - (#{build-global-reference\ 314}# - #{s\ 1946}# - #{value\ 1942}# - #{mod\ 1947}#) - (if (eqv? #{type\ 1941}# 'call) - (#{chi-application\ 460}# - (#{chi\ 456}# - (car #{e\ 1943}#) - #{r\ 1944}# - #{w\ 1945}# - #{mod\ 1947}#) - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) - (if (eqv? #{type\ 1941}# 'begin-form) - (let ((#{tmp\ 1977}# #{e\ 1943}#)) - (let ((#{tmp\ 1978}# + (if (eqv? #{type 1941}# 'global) + (#{build-global-reference 314}# + #{s 1946}# + #{value 1942}# + #{mod 1947}#) + (if (eqv? #{type 1941}# 'call) + (#{chi-application 460}# + (#{chi 456}# + (car #{e 1943}#) + #{r 1944}# + #{w 1945}# + #{mod 1947}#) + #{e 1943}# + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) + (if (eqv? #{type 1941}# 'begin-form) + (let ((#{tmp 1977}# #{e 1943}#)) + (let ((#{tmp 1978}# ($sc-dispatch - #{tmp\ 1977}# + #{tmp 1977}# '(_ any . each-any)))) - (if #{tmp\ 1978}# + (if #{tmp 1978}# (@apply - (lambda (#{e1\ 1981}# #{e2\ 1982}#) - (#{chi-sequence\ 446}# - (cons #{e1\ 1981}# #{e2\ 1982}#) - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#)) - #{tmp\ 1978}#) + (lambda (#{e1 1981}# #{e2 1982}#) + (#{chi-sequence 446}# + (cons #{e1 1981}# #{e2 1982}#) + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#)) + #{tmp 1978}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1977}#)))) - (if (eqv? #{type\ 1941}# 'local-syntax-form) - (#{chi-local-syntax\ 466}# - #{value\ 1942}# - #{e\ 1943}# - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}# - #{chi-sequence\ 446}#) - (if (eqv? #{type\ 1941}# 'eval-when-form) - (let ((#{tmp\ 1986}# #{e\ 1943}#)) - (let ((#{tmp\ 1987}# + #{tmp 1977}#)))) + (if (eqv? #{type 1941}# 'local-syntax-form) + (#{chi-local-syntax 466}# + #{value 1942}# + #{e 1943}# + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}# + #{chi-sequence 446}#) + (if (eqv? #{type 1941}# 'eval-when-form) + (let ((#{tmp 1986}# #{e 1943}#)) + (let ((#{tmp 1987}# ($sc-dispatch - #{tmp\ 1986}# + #{tmp 1986}# '(_ each-any any . each-any)))) - (if #{tmp\ 1987}# + (if #{tmp 1987}# (@apply - (lambda (#{x\ 1991}# - #{e1\ 1992}# - #{e2\ 1993}#) + (lambda (#{x 1991}# + #{e1 1992}# + #{e2 1993}#) (begin - (let ((#{when-list\ 1995}# - (#{chi-when-list\ 452}# - #{e\ 1943}# - #{x\ 1991}# - #{w\ 1945}#))) + (let ((#{when-list 1995}# + (#{chi-when-list 452}# + #{e 1943}# + #{x 1991}# + #{w 1945}#))) (if (memq 'eval - #{when-list\ 1995}#) - (#{chi-sequence\ 446}# - (cons #{e1\ 1992}# - #{e2\ 1993}#) - #{r\ 1944}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#) - (#{chi-void\ 470}#))))) - #{tmp\ 1987}#) + #{when-list 1995}#) + (#{chi-sequence 446}# + (cons #{e1 1992}# + #{e2 1993}#) + #{r 1944}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#) + (#{chi-void 470}#))))) + #{tmp 1987}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 1986}#)))) - (if (if (eqv? #{type\ 1941}# 'define-form) + #{tmp 1986}#)))) + (if (if (eqv? #{type 1941}# 'define-form) #t - (eqv? #{type\ 1941}# + (eqv? #{type 1941}# 'define-syntax-form)) (syntax-violation #f "definition in expression context" - #{e\ 1943}# - (#{wrap\ 442}# - #{value\ 1942}# - #{w\ 1945}# - #{mod\ 1947}#)) - (if (eqv? #{type\ 1941}# 'syntax) + #{e 1943}# + (#{wrap 442}# + #{value 1942}# + #{w 1945}# + #{mod 1947}#)) + (if (eqv? #{type 1941}# 'syntax) (syntax-violation #f "reference to pattern variable outside syntax form" - (#{source-wrap\ 444}# - #{e\ 1943}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#)) - (if (eqv? #{type\ 1941}# + (#{source-wrap 444}# + #{e 1943}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#)) + (if (eqv? #{type 1941}# 'displaced-lexical) (syntax-violation #f "reference to identifier outside its scope" - (#{source-wrap\ 444}# - #{e\ 1943}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#)) + (#{source-wrap 444}# + #{e 1943}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#)) (syntax-violation #f "unexpected syntax" - (#{source-wrap\ 444}# - #{e\ 1943}# - #{w\ 1945}# - #{s\ 1946}# - #{mod\ 1947}#)))))))))))))))))) - (#{chi-application\ 460}# - (lambda (#{x\ 2002}# - #{e\ 2003}# - #{r\ 2004}# - #{w\ 2005}# - #{s\ 2006}# - #{mod\ 2007}#) - (let ((#{tmp\ 2014}# #{e\ 2003}#)) - (let ((#{tmp\ 2015}# - ($sc-dispatch #{tmp\ 2014}# '(any . each-any)))) - (if #{tmp\ 2015}# + (#{source-wrap 444}# + #{e 1943}# + #{w 1945}# + #{s 1946}# + #{mod 1947}#)))))))))))))))))) + (#{chi-application 460}# + (lambda (#{x 2002}# + #{e 2003}# + #{r 2004}# + #{w 2005}# + #{s 2006}# + #{mod 2007}#) + (let ((#{tmp 2014}# #{e 2003}#)) + (let ((#{tmp 2015}# + ($sc-dispatch #{tmp 2014}# '(any . each-any)))) + (if #{tmp 2015}# (@apply - (lambda (#{e0\ 2018}# #{e1\ 2019}#) - (#{build-application\ 302}# - #{s\ 2006}# - #{x\ 2002}# - (map (lambda (#{e\ 2020}#) - (#{chi\ 456}# - #{e\ 2020}# - #{r\ 2004}# - #{w\ 2005}# - #{mod\ 2007}#)) - #{e1\ 2019}#))) - #{tmp\ 2015}#) + (lambda (#{e0 2018}# #{e1 2019}#) + (#{build-application 302}# + #{s 2006}# + #{x 2002}# + (map (lambda (#{e 2020}#) + (#{chi 456}# + #{e 2020}# + #{r 2004}# + #{w 2005}# + #{mod 2007}#)) + #{e1 2019}#))) + #{tmp 2015}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2014}#)))))) - (#{chi-macro\ 462}# - (lambda (#{p\ 2023}# - #{e\ 2024}# - #{r\ 2025}# - #{w\ 2026}# - #{s\ 2027}# - #{rib\ 2028}# - #{mod\ 2029}#) + #{tmp 2014}#)))))) + (#{chi-macro 462}# + (lambda (#{p 2023}# + #{e 2024}# + #{r 2025}# + #{w 2026}# + #{s 2027}# + #{rib 2028}# + #{mod 2029}#) (letrec* - ((#{rebuild-macro-output\ 2038}# - (lambda (#{x\ 2039}# #{m\ 2040}#) - (if (pair? #{x\ 2039}#) - (#{decorate-source\ 296}# - (cons (#{rebuild-macro-output\ 2038}# - (car #{x\ 2039}#) - #{m\ 2040}#) - (#{rebuild-macro-output\ 2038}# - (cdr #{x\ 2039}#) - #{m\ 2040}#)) - #{s\ 2027}#) - (if (#{syntax-object?\ 342}# #{x\ 2039}#) + ((#{rebuild-macro-output 2038}# + (lambda (#{x 2039}# #{m 2040}#) + (if (pair? #{x 2039}#) + (#{decorate-source 296}# + (cons (#{rebuild-macro-output 2038}# + (car #{x 2039}#) + #{m 2040}#) + (#{rebuild-macro-output 2038}# + (cdr #{x 2039}#) + #{m 2040}#)) + #{s 2027}#) + (if (#{syntax-object? 342}# #{x 2039}#) (begin - (let ((#{w\ 2048}# - (#{syntax-object-wrap\ 346}# #{x\ 2039}#))) + (let ((#{w 2048}# + (#{syntax-object-wrap 346}# #{x 2039}#))) (begin - (let ((#{ms\ 2051}# (car #{w\ 2048}#)) - (#{s\ 2052}# (cdr #{w\ 2048}#))) - (if (if (pair? #{ms\ 2051}#) - (eq? (car #{ms\ 2051}#) #f) + (let ((#{ms 2051}# (car #{w 2048}#)) + (#{s 2052}# (cdr #{w 2048}#))) + (if (if (pair? #{ms 2051}#) + (eq? (car #{ms 2051}#) #f) #f) - (#{make-syntax-object\ 340}# - (#{syntax-object-expression\ 344}# - #{x\ 2039}#) - (cons (cdr #{ms\ 2051}#) - (if #{rib\ 2028}# - (cons #{rib\ 2028}# - (cdr #{s\ 2052}#)) - (cdr #{s\ 2052}#))) - (#{syntax-object-module\ 348}# #{x\ 2039}#)) - (#{make-syntax-object\ 340}# - (#{decorate-source\ 296}# - (#{syntax-object-expression\ 344}# - #{x\ 2039}#) - #{s\ 2052}#) - (cons (cons #{m\ 2040}# #{ms\ 2051}#) - (if #{rib\ 2028}# - (cons #{rib\ 2028}# - (cons 'shift #{s\ 2052}#)) - (cons 'shift #{s\ 2052}#))) - (#{syntax-object-module\ 348}# - #{x\ 2039}#))))))) - (if (vector? #{x\ 2039}#) + (#{make-syntax-object 340}# + (#{syntax-object-expression 344}# #{x 2039}#) + (cons (cdr #{ms 2051}#) + (if #{rib 2028}# + (cons #{rib 2028}# (cdr #{s 2052}#)) + (cdr #{s 2052}#))) + (#{syntax-object-module 348}# #{x 2039}#)) + (#{make-syntax-object 340}# + (#{decorate-source 296}# + (#{syntax-object-expression 344}# + #{x 2039}#) + #{s 2052}#) + (cons (cons #{m 2040}# #{ms 2051}#) + (if #{rib 2028}# + (cons #{rib 2028}# + (cons 'shift #{s 2052}#)) + (cons 'shift #{s 2052}#))) + (#{syntax-object-module 348}# + #{x 2039}#))))))) + (if (vector? #{x 2039}#) (begin - (let ((#{n\ 2064}# (vector-length #{x\ 2039}#))) + (let ((#{n 2064}# (vector-length #{x 2039}#))) (begin - (let ((#{v\ 2066}# - (#{decorate-source\ 296}# - (make-vector #{n\ 2064}#) - #{x\ 2039}#))) + (let ((#{v 2066}# + (#{decorate-source 296}# + (make-vector #{n 2064}#) + #{x 2039}#))) (letrec* - ((#{loop\ 2069}# - (lambda (#{i\ 2070}#) - (if (= #{i\ 2070}# #{n\ 2064}#) - (begin (if #f #f) #{v\ 2066}#) + ((#{loop 2069}# + (lambda (#{i 2070}#) + (if (= #{i 2070}# #{n 2064}#) + (begin (if #f #f) #{v 2066}#) (begin (vector-set! - #{v\ 2066}# - #{i\ 2070}# - (#{rebuild-macro-output\ 2038}# + #{v 2066}# + #{i 2070}# + (#{rebuild-macro-output 2038}# (vector-ref - #{x\ 2039}# - #{i\ 2070}#) - #{m\ 2040}#)) - (#{loop\ 2069}# - (1+ #{i\ 2070}#))))))) - (begin (#{loop\ 2069}# 0))))))) - (if (symbol? #{x\ 2039}#) + #{x 2039}# + #{i 2070}#) + #{m 2040}#)) + (#{loop 2069}# + (#{1+}# #{i 2070}#))))))) + (begin (#{loop 2069}# 0))))))) + (if (symbol? #{x 2039}#) (syntax-violation #f "encountered raw symbol in macro output" - (#{source-wrap\ 444}# - #{e\ 2024}# - #{w\ 2026}# - (cdr #{w\ 2026}#) - #{mod\ 2029}#) - #{x\ 2039}#) - (#{decorate-source\ 296}# - #{x\ 2039}# - #{s\ 2027}#)))))))) + (#{source-wrap 444}# + #{e 2024}# + #{w 2026}# + (cdr #{w 2026}#) + #{mod 2029}#) + #{x 2039}#) + (#{decorate-source 296}# + #{x 2039}# + #{s 2027}#)))))))) (begin - (#{rebuild-macro-output\ 2038}# - (#{p\ 2023}# - (#{source-wrap\ 444}# - #{e\ 2024}# - (#{anti-mark\ 414}# #{w\ 2026}#) - #{s\ 2027}# - #{mod\ 2029}#)) + (#{rebuild-macro-output 2038}# + (#{p 2023}# + (#{source-wrap 444}# + #{e 2024}# + (#{anti-mark 414}# #{w 2026}#) + #{s 2027}# + #{mod 2029}#)) (gensym "m")))))) - (#{chi-body\ 464}# - (lambda (#{body\ 2080}# - #{outer-form\ 2081}# - #{r\ 2082}# - #{w\ 2083}# - #{mod\ 2084}#) + (#{chi-body 464}# + (lambda (#{body 2080}# + #{outer-form 2081}# + #{r 2082}# + #{w 2083}# + #{mod 2084}#) (begin - (let ((#{r\ 2092}# - (cons '("placeholder" placeholder) #{r\ 2082}#))) + (let ((#{r 2092}# + (cons '("placeholder" placeholder) #{r 2082}#))) (begin - (let ((#{ribcage\ 2094}# - (#{make-ribcage\ 394}# '() '() '()))) + (let ((#{ribcage 2094}# + (#{make-ribcage 394}# '() '() '()))) (begin - (let ((#{w\ 2097}# - (cons (car #{w\ 2083}#) - (cons #{ribcage\ 2094}# - (cdr #{w\ 2083}#))))) + (let ((#{w 2097}# + (cons (car #{w 2083}#) + (cons #{ribcage 2094}# (cdr #{w 2083}#))))) (letrec* - ((#{parse\ 2109}# - (lambda (#{body\ 2110}# - #{ids\ 2111}# - #{labels\ 2112}# - #{var-ids\ 2113}# - #{vars\ 2114}# - #{vals\ 2115}# - #{bindings\ 2116}#) - (if (null? #{body\ 2110}#) + ((#{parse 2109}# + (lambda (#{body 2110}# + #{ids 2111}# + #{labels 2112}# + #{var-ids 2113}# + #{vars 2114}# + #{vals 2115}# + #{bindings 2116}#) + (if (null? #{body 2110}#) (syntax-violation #f "no expressions in body" - #{outer-form\ 2081}#) + #{outer-form 2081}#) (begin - (let ((#{e\ 2121}# - (cdr (car #{body\ 2110}#))) - (#{er\ 2122}# - (car (car #{body\ 2110}#)))) + (let ((#{e 2121}# (cdr (car #{body 2110}#))) + (#{er 2122}# + (car (car #{body 2110}#)))) (call-with-values (lambda () - (#{syntax-type\ 454}# - #{e\ 2121}# - #{er\ 2122}# + (#{syntax-type 454}# + #{e 2121}# + #{er 2122}# '(()) - (#{source-annotation\ 357}# - #{er\ 2122}#) - #{ribcage\ 2094}# - #{mod\ 2084}# + (#{source-annotation 357}# + #{er 2122}#) + #{ribcage 2094}# + #{mod 2084}# #f)) - (lambda (#{type\ 2124}# - #{value\ 2125}# - #{e\ 2126}# - #{w\ 2127}# - #{s\ 2128}# - #{mod\ 2129}#) - (if (eqv? #{type\ 2124}# 'define-form) + (lambda (#{type 2124}# + #{value 2125}# + #{e 2126}# + #{w 2127}# + #{s 2128}# + #{mod 2129}#) + (if (eqv? #{type 2124}# 'define-form) (begin - (let ((#{id\ 2139}# - (#{wrap\ 442}# - #{value\ 2125}# - #{w\ 2127}# - #{mod\ 2129}#)) - (#{label\ 2140}# - (#{gen-label\ 389}#))) + (let ((#{id 2139}# + (#{wrap 442}# + #{value 2125}# + #{w 2127}# + #{mod 2129}#)) + (#{label 2140}# + (#{gen-label 389}#))) (begin - (let ((#{var\ 2142}# - (#{gen-var\ 484}# - #{id\ 2139}#))) + (let ((#{var 2142}# + (#{gen-var 484}# + #{id 2139}#))) (begin - (#{extend-ribcage!\ 418}# - #{ribcage\ 2094}# - #{id\ 2139}# - #{label\ 2140}#) - (#{parse\ 2109}# - (cdr #{body\ 2110}#) - (cons #{id\ 2139}# - #{ids\ 2111}#) - (cons #{label\ 2140}# - #{labels\ 2112}#) - (cons #{id\ 2139}# - #{var-ids\ 2113}#) - (cons #{var\ 2142}# - #{vars\ 2114}#) - (cons (cons #{er\ 2122}# - (#{wrap\ 442}# - #{e\ 2126}# - #{w\ 2127}# - #{mod\ 2129}#)) - #{vals\ 2115}#) + (#{extend-ribcage! 418}# + #{ribcage 2094}# + #{id 2139}# + #{label 2140}#) + (#{parse 2109}# + (cdr #{body 2110}#) + (cons #{id 2139}# + #{ids 2111}#) + (cons #{label 2140}# + #{labels 2112}#) + (cons #{id 2139}# + #{var-ids 2113}#) + (cons #{var 2142}# + #{vars 2114}#) + (cons (cons #{er 2122}# + (#{wrap 442}# + #{e 2126}# + #{w 2127}# + #{mod 2129}#)) + #{vals 2115}#) (cons (cons 'lexical - #{var\ 2142}#) - #{bindings\ 2116}#))))))) - (if (eqv? #{type\ 2124}# + #{var 2142}#) + #{bindings 2116}#))))))) + (if (eqv? #{type 2124}# 'define-syntax-form) (begin - (let ((#{id\ 2147}# - (#{wrap\ 442}# - #{value\ 2125}# - #{w\ 2127}# - #{mod\ 2129}#)) - (#{label\ 2148}# - (#{gen-label\ 389}#))) + (let ((#{id 2147}# + (#{wrap 442}# + #{value 2125}# + #{w 2127}# + #{mod 2129}#)) + (#{label 2148}# + (#{gen-label 389}#))) (begin - (#{extend-ribcage!\ 418}# - #{ribcage\ 2094}# - #{id\ 2147}# - #{label\ 2148}#) - (#{parse\ 2109}# - (cdr #{body\ 2110}#) - (cons #{id\ 2147}# - #{ids\ 2111}#) - (cons #{label\ 2148}# - #{labels\ 2112}#) - #{var-ids\ 2113}# - #{vars\ 2114}# - #{vals\ 2115}# + (#{extend-ribcage! 418}# + #{ribcage 2094}# + #{id 2147}# + #{label 2148}#) + (#{parse 2109}# + (cdr #{body 2110}#) + (cons #{id 2147}# + #{ids 2111}#) + (cons #{label 2148}# + #{labels 2112}#) + #{var-ids 2113}# + #{vars 2114}# + #{vals 2115}# (cons (cons 'macro - (cons #{er\ 2122}# - (#{wrap\ 442}# - #{e\ 2126}# - #{w\ 2127}# - #{mod\ 2129}#))) - #{bindings\ 2116}#))))) - (if (eqv? #{type\ 2124}# + (cons #{er 2122}# + (#{wrap 442}# + #{e 2126}# + #{w 2127}# + #{mod 2129}#))) + #{bindings 2116}#))))) + (if (eqv? #{type 2124}# 'begin-form) - (let ((#{tmp\ 2151}# - #{e\ 2126}#)) - (let ((#{tmp\ 2152}# + (let ((#{tmp 2151}# #{e 2126}#)) + (let ((#{tmp 2152}# ($sc-dispatch - #{tmp\ 2151}# + #{tmp 2151}# '(_ . each-any)))) - (if #{tmp\ 2152}# + (if #{tmp 2152}# (@apply - (lambda (#{e1\ 2154}#) - (#{parse\ 2109}# + (lambda (#{e1 2154}#) + (#{parse 2109}# (letrec* - ((#{f\ 2157}# - (lambda (#{forms\ 2158}#) - (if (null? #{forms\ 2158}#) - (cdr #{body\ 2110}#) - (cons (cons #{er\ 2122}# - (#{wrap\ 442}# - (car #{forms\ 2158}#) - #{w\ 2127}# - #{mod\ 2129}#)) - (#{f\ 2157}# - (cdr #{forms\ 2158}#))))))) + ((#{f 2157}# + (lambda (#{forms 2158}#) + (if (null? #{forms 2158}#) + (cdr #{body 2110}#) + (cons (cons #{er 2122}# + (#{wrap 442}# + (car #{forms 2158}#) + #{w 2127}# + #{mod 2129}#)) + (#{f 2157}# + (cdr #{forms 2158}#))))))) (begin - (#{f\ 2157}# - #{e1\ 2154}#))) - #{ids\ 2111}# - #{labels\ 2112}# - #{var-ids\ 2113}# - #{vars\ 2114}# - #{vals\ 2115}# - #{bindings\ 2116}#)) - #{tmp\ 2152}#) + (#{f 2157}# + #{e1 2154}#))) + #{ids 2111}# + #{labels 2112}# + #{var-ids 2113}# + #{vars 2114}# + #{vals 2115}# + #{bindings 2116}#)) + #{tmp 2152}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2151}#)))) - (if (eqv? #{type\ 2124}# + #{tmp 2151}#)))) + (if (eqv? #{type 2124}# 'local-syntax-form) - (#{chi-local-syntax\ 466}# - #{value\ 2125}# - #{e\ 2126}# - #{er\ 2122}# - #{w\ 2127}# - #{s\ 2128}# - #{mod\ 2129}# - (lambda (#{forms\ 2161}# - #{er\ 2162}# - #{w\ 2163}# - #{s\ 2164}# - #{mod\ 2165}#) - (#{parse\ 2109}# + (#{chi-local-syntax 466}# + #{value 2125}# + #{e 2126}# + #{er 2122}# + #{w 2127}# + #{s 2128}# + #{mod 2129}# + (lambda (#{forms 2161}# + #{er 2162}# + #{w 2163}# + #{s 2164}# + #{mod 2165}#) + (#{parse 2109}# (letrec* - ((#{f\ 2173}# - (lambda (#{forms\ 2174}#) - (if (null? #{forms\ 2174}#) - (cdr #{body\ 2110}#) - (cons (cons #{er\ 2162}# - (#{wrap\ 442}# - (car #{forms\ 2174}#) - #{w\ 2163}# - #{mod\ 2165}#)) - (#{f\ 2173}# - (cdr #{forms\ 2174}#))))))) + ((#{f 2173}# + (lambda (#{forms 2174}#) + (if (null? #{forms 2174}#) + (cdr #{body 2110}#) + (cons (cons #{er 2162}# + (#{wrap 442}# + (car #{forms 2174}#) + #{w 2163}# + #{mod 2165}#)) + (#{f 2173}# + (cdr #{forms 2174}#))))))) (begin - (#{f\ 2173}# - #{forms\ 2161}#))) - #{ids\ 2111}# - #{labels\ 2112}# - #{var-ids\ 2113}# - #{vars\ 2114}# - #{vals\ 2115}# - #{bindings\ 2116}#))) - (if (null? #{ids\ 2111}#) - (#{build-sequence\ 330}# + (#{f 2173}# + #{forms 2161}#))) + #{ids 2111}# + #{labels 2112}# + #{var-ids 2113}# + #{vars 2114}# + #{vals 2115}# + #{bindings 2116}#))) + (if (null? #{ids 2111}#) + (#{build-sequence 330}# #f - (map (lambda (#{x\ 2177}#) - (#{chi\ 456}# - (cdr #{x\ 2177}#) - (car #{x\ 2177}#) + (map (lambda (#{x 2177}#) + (#{chi 456}# + (cdr #{x 2177}#) + (car #{x 2177}#) '(()) - #{mod\ 2129}#)) - (cons (cons #{er\ 2122}# - (#{source-wrap\ 444}# - #{e\ 2126}# - #{w\ 2127}# - #{s\ 2128}# - #{mod\ 2129}#)) - (cdr #{body\ 2110}#)))) + #{mod 2129}#)) + (cons (cons #{er 2122}# + (#{source-wrap 444}# + #{e 2126}# + #{w 2127}# + #{s 2128}# + #{mod 2129}#)) + (cdr #{body 2110}#)))) (begin - (if (not (#{valid-bound-ids?\ 436}# - #{ids\ 2111}#)) + (if (not (#{valid-bound-ids? 436}# + #{ids 2111}#)) (syntax-violation #f "invalid or duplicate identifier in definition" - #{outer-form\ 2081}#)) + #{outer-form 2081}#)) (letrec* - ((#{loop\ 2184}# - (lambda (#{bs\ 2185}# - #{er-cache\ 2186}# - #{r-cache\ 2187}#) - (if (not (null? #{bs\ 2185}#)) + ((#{loop 2184}# + (lambda (#{bs 2185}# + #{er-cache 2186}# + #{r-cache 2187}#) + (if (not (null? #{bs 2185}#)) (begin - (let ((#{b\ 2190}# - (car #{bs\ 2185}#))) - (if (eq? (car #{b\ 2190}#) + (let ((#{b 2190}# + (car #{bs 2185}#))) + (if (eq? (car #{b 2190}#) 'macro) (begin - (let ((#{er\ 2193}# - (car (cdr #{b\ 2190}#)))) + (let ((#{er 2193}# + (car (cdr #{b 2190}#)))) (begin - (let ((#{r-cache\ 2195}# - (if (eq? #{er\ 2193}# - #{er-cache\ 2186}#) - #{r-cache\ 2187}# - (#{macros-only-env\ 368}# - #{er\ 2193}#)))) + (let ((#{r-cache 2195}# + (if (eq? #{er 2193}# + #{er-cache 2186}#) + #{r-cache 2187}# + (#{macros-only-env 368}# + #{er 2193}#)))) (begin (set-cdr! - #{b\ 2190}# - (#{eval-local-transformer\ 468}# - (#{chi\ 456}# - (cdr (cdr #{b\ 2190}#)) - #{r-cache\ 2195}# + #{b 2190}# + (#{eval-local-transformer 468}# + (#{chi 456}# + (cdr (cdr #{b 2190}#)) + #{r-cache 2195}# '(()) - #{mod\ 2129}#) - #{mod\ 2129}#)) - (#{loop\ 2184}# - (cdr #{bs\ 2185}#) - #{er\ 2193}# - #{r-cache\ 2195}#)))))) - (#{loop\ 2184}# - (cdr #{bs\ 2185}#) - #{er-cache\ 2186}# - #{r-cache\ 2187}#)))))))) + #{mod 2129}#) + #{mod 2129}#)) + (#{loop 2184}# + (cdr #{bs 2185}#) + #{er 2193}# + #{r-cache 2195}#)))))) + (#{loop 2184}# + (cdr #{bs 2185}#) + #{er-cache 2186}# + #{r-cache 2187}#)))))))) (begin - (#{loop\ 2184}# - #{bindings\ 2116}# + (#{loop 2184}# + #{bindings 2116}# #f #f))) (set-cdr! - #{r\ 2092}# - (#{extend-env\ 364}# - #{labels\ 2112}# - #{bindings\ 2116}# - (cdr #{r\ 2092}#))) - (#{build-letrec\ 336}# + #{r 2092}# + (#{extend-env 364}# + #{labels 2112}# + #{bindings 2116}# + (cdr #{r 2092}#))) + (#{build-letrec 336}# #f #t (reverse (map syntax->datum - #{var-ids\ 2113}#)) - (reverse #{vars\ 2114}#) - (map (lambda (#{x\ 2198}#) - (#{chi\ 456}# - (cdr #{x\ 2198}#) - (car #{x\ 2198}#) + #{var-ids 2113}#)) + (reverse #{vars 2114}#) + (map (lambda (#{x 2198}#) + (#{chi 456}# + (cdr #{x 2198}#) + (car #{x 2198}#) '(()) - #{mod\ 2129}#)) + #{mod 2129}#)) (reverse - #{vals\ 2115}#)) - (#{build-sequence\ 330}# + #{vals 2115}#)) + (#{build-sequence 330}# #f - (map (lambda (#{x\ 2202}#) - (#{chi\ 456}# - (cdr #{x\ 2202}#) - (car #{x\ 2202}#) + (map (lambda (#{x 2202}#) + (#{chi 456}# + (cdr #{x 2202}#) + (car #{x 2202}#) '(()) - #{mod\ 2129}#)) - (cons (cons #{er\ 2122}# - (#{source-wrap\ 444}# - #{e\ 2126}# - #{w\ 2127}# - #{s\ 2128}# - #{mod\ 2129}#)) - (cdr #{body\ 2110}#))))))))))))))))))) + #{mod 2129}#)) + (cons (cons #{er 2122}# + (#{source-wrap 444}# + #{e 2126}# + #{w 2127}# + #{s 2128}# + #{mod 2129}#)) + (cdr #{body 2110}#))))))))))))))))))) (begin - (#{parse\ 2109}# - (map (lambda (#{x\ 2117}#) - (cons #{r\ 2092}# - (#{wrap\ 442}# - #{x\ 2117}# - #{w\ 2097}# - #{mod\ 2084}#))) - #{body\ 2080}#) + (#{parse 2109}# + (map (lambda (#{x 2117}#) + (cons #{r 2092}# + (#{wrap 442}# + #{x 2117}# + #{w 2097}# + #{mod 2084}#))) + #{body 2080}#) '() '() '() '() '() '()))))))))))) - (#{chi-local-syntax\ 466}# - (lambda (#{rec?\ 2205}# - #{e\ 2206}# - #{r\ 2207}# - #{w\ 2208}# - #{s\ 2209}# - #{mod\ 2210}# - #{k\ 2211}#) - (let ((#{tmp\ 2219}# #{e\ 2206}#)) - (let ((#{tmp\ 2220}# + (#{chi-local-syntax 466}# + (lambda (#{rec? 2205}# + #{e 2206}# + #{r 2207}# + #{w 2208}# + #{s 2209}# + #{mod 2210}# + #{k 2211}#) + (let ((#{tmp 2219}# #{e 2206}#)) + (let ((#{tmp 2220}# ($sc-dispatch - #{tmp\ 2219}# + #{tmp 2219}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 2220}# + (if #{tmp 2220}# (@apply - (lambda (#{id\ 2225}# - #{val\ 2226}# - #{e1\ 2227}# - #{e2\ 2228}#) + (lambda (#{id 2225}# + #{val 2226}# + #{e1 2227}# + #{e2 2228}#) (begin - (let ((#{ids\ 2230}# #{id\ 2225}#)) - (if (not (#{valid-bound-ids?\ 436}# #{ids\ 2230}#)) + (let ((#{ids 2230}# #{id 2225}#)) + (if (not (#{valid-bound-ids? 436}# #{ids 2230}#)) (syntax-violation #f "duplicate bound keyword" - #{e\ 2206}#) + #{e 2206}#) (begin - (let ((#{labels\ 2233}# - (#{gen-labels\ 391}# #{ids\ 2230}#))) + (let ((#{labels 2233}# + (#{gen-labels 391}# #{ids 2230}#))) (begin - (let ((#{new-w\ 2235}# - (#{make-binding-wrap\ 420}# - #{ids\ 2230}# - #{labels\ 2233}# - #{w\ 2208}#))) - (#{k\ 2211}# - (cons #{e1\ 2227}# #{e2\ 2228}#) - (#{extend-env\ 364}# - #{labels\ 2233}# + (let ((#{new-w 2235}# + (#{make-binding-wrap 420}# + #{ids 2230}# + #{labels 2233}# + #{w 2208}#))) + (#{k 2211}# + (cons #{e1 2227}# #{e2 2228}#) + (#{extend-env 364}# + #{labels 2233}# (begin - (let ((#{w\ 2239}# - (if #{rec?\ 2205}# - #{new-w\ 2235}# - #{w\ 2208}#)) - (#{trans-r\ 2240}# - (#{macros-only-env\ 368}# - #{r\ 2207}#))) - (map (lambda (#{x\ 2241}#) + (let ((#{w 2239}# + (if #{rec? 2205}# + #{new-w 2235}# + #{w 2208}#)) + (#{trans-r 2240}# + (#{macros-only-env 368}# + #{r 2207}#))) + (map (lambda (#{x 2241}#) (cons 'macro - (#{eval-local-transformer\ 468}# - (#{chi\ 456}# - #{x\ 2241}# - #{trans-r\ 2240}# - #{w\ 2239}# - #{mod\ 2210}#) - #{mod\ 2210}#))) - #{val\ 2226}#))) - #{r\ 2207}#) - #{new-w\ 2235}# - #{s\ 2209}# - #{mod\ 2210}#))))))))) - #{tmp\ 2220}#) - (let ((#{_\ 2246}# #{tmp\ 2219}#)) + (#{eval-local-transformer 468}# + (#{chi 456}# + #{x 2241}# + #{trans-r 2240}# + #{w 2239}# + #{mod 2210}#) + #{mod 2210}#))) + #{val 2226}#))) + #{r 2207}#) + #{new-w 2235}# + #{s 2209}# + #{mod 2210}#))))))))) + #{tmp 2220}#) + (let ((#{_ 2246}# #{tmp 2219}#)) (syntax-violation #f "bad local syntax definition" - (#{source-wrap\ 444}# - #{e\ 2206}# - #{w\ 2208}# - #{s\ 2209}# - #{mod\ 2210}#)))))))) - (#{eval-local-transformer\ 468}# - (lambda (#{expanded\ 2247}# #{mod\ 2248}#) + (#{source-wrap 444}# + #{e 2206}# + #{w 2208}# + #{s 2209}# + #{mod 2210}#)))))))) + (#{eval-local-transformer 468}# + (lambda (#{expanded 2247}# #{mod 2248}#) (begin - (let ((#{p\ 2252}# - (#{local-eval-hook\ 289}# - #{expanded\ 2247}# - #{mod\ 2248}#))) - (if (procedure? #{p\ 2252}#) - #{p\ 2252}# + (let ((#{p 2252}# + (#{local-eval-hook 289}# + #{expanded 2247}# + #{mod 2248}#))) + (if (procedure? #{p 2252}#) + #{p 2252}# (syntax-violation #f "nonprocedure transformer" - #{p\ 2252}#)))))) - (#{chi-void\ 470}# - (lambda () (#{build-void\ 300}# #f))) - (#{ellipsis?\ 472}# - (lambda (#{x\ 2254}#) - (if (#{nonsymbol-id?\ 374}# #{x\ 2254}#) - (#{free-id=?\ 432}# - #{x\ 2254}# + #{p 2252}#)))))) + (#{chi-void 470}# + (lambda () (#{build-void 300}# #f))) + (#{ellipsis? 472}# + (lambda (#{x 2254}#) + (if (#{nonsymbol-id? 374}# #{x 2254}#) + (#{free-id=? 432}# + #{x 2254}# '#(syntax-object ... ((top) @@ -6866,243 +6846,241 @@ ("i41" "i40" "i39" "i37"))) (hygiene guile))) #f))) - (#{lambda-formals\ 474}# - (lambda (#{orig-args\ 2258}#) + (#{lambda-formals 474}# + (lambda (#{orig-args 2258}#) (letrec* - ((#{req\ 2261}# - (lambda (#{args\ 2264}# #{rreq\ 2265}#) - (let ((#{tmp\ 2268}# #{args\ 2264}#)) - (let ((#{tmp\ 2269}# ($sc-dispatch #{tmp\ 2268}# '()))) - (if #{tmp\ 2269}# + ((#{req 2261}# + (lambda (#{args 2264}# #{rreq 2265}#) + (let ((#{tmp 2268}# #{args 2264}#)) + (let ((#{tmp 2269}# ($sc-dispatch #{tmp 2268}# '()))) + (if #{tmp 2269}# (@apply (lambda () - (#{check\ 2263}# (reverse #{rreq\ 2265}#) #f)) - #{tmp\ 2269}#) - (let ((#{tmp\ 2270}# - ($sc-dispatch #{tmp\ 2268}# '(any . any)))) - (if (if #{tmp\ 2270}# + (#{check 2263}# (reverse #{rreq 2265}#) #f)) + #{tmp 2269}#) + (let ((#{tmp 2270}# + ($sc-dispatch #{tmp 2268}# '(any . any)))) + (if (if #{tmp 2270}# (@apply - (lambda (#{a\ 2273}# #{b\ 2274}#) - (#{id?\ 376}# #{a\ 2273}#)) - #{tmp\ 2270}#) + (lambda (#{a 2273}# #{b 2274}#) + (#{id? 376}# #{a 2273}#)) + #{tmp 2270}#) #f) (@apply - (lambda (#{a\ 2277}# #{b\ 2278}#) - (#{req\ 2261}# - #{b\ 2278}# - (cons #{a\ 2277}# #{rreq\ 2265}#))) - #{tmp\ 2270}#) - (let ((#{tmp\ 2279}# (list #{tmp\ 2268}#))) - (if (if #{tmp\ 2279}# + (lambda (#{a 2277}# #{b 2278}#) + (#{req 2261}# + #{b 2278}# + (cons #{a 2277}# #{rreq 2265}#))) + #{tmp 2270}#) + (let ((#{tmp 2279}# (list #{tmp 2268}#))) + (if (if #{tmp 2279}# (@apply - (lambda (#{r\ 2281}#) - (#{id?\ 376}# #{r\ 2281}#)) - #{tmp\ 2279}#) + (lambda (#{r 2281}#) + (#{id? 376}# #{r 2281}#)) + #{tmp 2279}#) #f) (@apply - (lambda (#{r\ 2283}#) - (#{check\ 2263}# - (reverse #{rreq\ 2265}#) - #{r\ 2283}#)) - #{tmp\ 2279}#) - (let ((#{else\ 2285}# #{tmp\ 2268}#)) + (lambda (#{r 2283}#) + (#{check 2263}# + (reverse #{rreq 2265}#) + #{r 2283}#)) + #{tmp 2279}#) + (let ((#{else 2285}# #{tmp 2268}#)) (syntax-violation 'lambda "invalid argument list" - #{orig-args\ 2258}# - #{args\ 2264}#))))))))))) - (#{check\ 2263}# - (lambda (#{req\ 2286}# #{rest\ 2287}#) - (if (#{distinct-bound-ids?\ 438}# - (if #{rest\ 2287}# - (cons #{rest\ 2287}# #{req\ 2286}#) - #{req\ 2286}#)) - (values #{req\ 2286}# #f #{rest\ 2287}# #f) + #{orig-args 2258}# + #{args 2264}#))))))))))) + (#{check 2263}# + (lambda (#{req 2286}# #{rest 2287}#) + (if (#{distinct-bound-ids? 438}# + (if #{rest 2287}# + (cons #{rest 2287}# #{req 2286}#) + #{req 2286}#)) + (values #{req 2286}# #f #{rest 2287}# #f) (syntax-violation 'lambda "duplicate identifier in argument list" - #{orig-args\ 2258}#))))) - (begin (#{req\ 2261}# #{orig-args\ 2258}# '()))))) - (#{chi-simple-lambda\ 476}# - (lambda (#{e\ 2293}# - #{r\ 2294}# - #{w\ 2295}# - #{s\ 2296}# - #{mod\ 2297}# - #{req\ 2298}# - #{rest\ 2299}# - #{meta\ 2300}# - #{body\ 2301}#) + #{orig-args 2258}#))))) + (begin (#{req 2261}# #{orig-args 2258}# '()))))) + (#{chi-simple-lambda 476}# + (lambda (#{e 2293}# + #{r 2294}# + #{w 2295}# + #{s 2296}# + #{mod 2297}# + #{req 2298}# + #{rest 2299}# + #{meta 2300}# + #{body 2301}#) (begin - (let ((#{ids\ 2313}# - (if #{rest\ 2299}# - (append #{req\ 2298}# (list #{rest\ 2299}#)) - #{req\ 2298}#))) + (let ((#{ids 2313}# + (if #{rest 2299}# + (append #{req 2298}# (list #{rest 2299}#)) + #{req 2298}#))) (begin - (let ((#{vars\ 2315}# - (map #{gen-var\ 484}# #{ids\ 2313}#))) + (let ((#{vars 2315}# + (map #{gen-var 484}# #{ids 2313}#))) (begin - (let ((#{labels\ 2317}# - (#{gen-labels\ 391}# #{ids\ 2313}#))) - (#{build-simple-lambda\ 320}# - #{s\ 2296}# - (map syntax->datum #{req\ 2298}#) - (if #{rest\ 2299}# - (syntax->datum #{rest\ 2299}#) + (let ((#{labels 2317}# + (#{gen-labels 391}# #{ids 2313}#))) + (#{build-simple-lambda 320}# + #{s 2296}# + (map syntax->datum #{req 2298}#) + (if #{rest 2299}# + (syntax->datum #{rest 2299}#) #f) - #{vars\ 2315}# - #{meta\ 2300}# - (#{chi-body\ 464}# - #{body\ 2301}# - (#{source-wrap\ 444}# - #{e\ 2293}# - #{w\ 2295}# - #{s\ 2296}# - #{mod\ 2297}#) - (#{extend-var-env\ 366}# - #{labels\ 2317}# - #{vars\ 2315}# - #{r\ 2294}#) - (#{make-binding-wrap\ 420}# - #{ids\ 2313}# - #{labels\ 2317}# - #{w\ 2295}#) - #{mod\ 2297}#)))))))))) - (#{lambda*-formals\ 478}# - (lambda (#{orig-args\ 2320}#) + #{vars 2315}# + #{meta 2300}# + (#{chi-body 464}# + #{body 2301}# + (#{source-wrap 444}# + #{e 2293}# + #{w 2295}# + #{s 2296}# + #{mod 2297}#) + (#{extend-var-env 366}# + #{labels 2317}# + #{vars 2315}# + #{r 2294}#) + (#{make-binding-wrap 420}# + #{ids 2313}# + #{labels 2317}# + #{w 2295}#) + #{mod 2297}#)))))))))) + (#{lambda*-formals 478}# + (lambda (#{orig-args 2320}#) (letrec* - ((#{req\ 2323}# - (lambda (#{args\ 2332}# #{rreq\ 2333}#) - (let ((#{tmp\ 2336}# #{args\ 2332}#)) - (let ((#{tmp\ 2337}# ($sc-dispatch #{tmp\ 2336}# '()))) - (if #{tmp\ 2337}# + ((#{req 2323}# + (lambda (#{args 2332}# #{rreq 2333}#) + (let ((#{tmp 2336}# #{args 2332}#)) + (let ((#{tmp 2337}# ($sc-dispatch #{tmp 2336}# '()))) + (if #{tmp 2337}# (@apply (lambda () - (#{check\ 2331}# - (reverse #{rreq\ 2333}#) + (#{check 2331}# + (reverse #{rreq 2333}#) '() #f '())) - #{tmp\ 2337}#) - (let ((#{tmp\ 2338}# - ($sc-dispatch #{tmp\ 2336}# '(any . any)))) - (if (if #{tmp\ 2338}# + #{tmp 2337}#) + (let ((#{tmp 2338}# + ($sc-dispatch #{tmp 2336}# '(any . any)))) + (if (if #{tmp 2338}# (@apply - (lambda (#{a\ 2341}# #{b\ 2342}#) - (#{id?\ 376}# #{a\ 2341}#)) - #{tmp\ 2338}#) + (lambda (#{a 2341}# #{b 2342}#) + (#{id? 376}# #{a 2341}#)) + #{tmp 2338}#) #f) (@apply - (lambda (#{a\ 2345}# #{b\ 2346}#) - (#{req\ 2323}# - #{b\ 2346}# - (cons #{a\ 2345}# #{rreq\ 2333}#))) - #{tmp\ 2338}#) - (let ((#{tmp\ 2347}# - ($sc-dispatch #{tmp\ 2336}# '(any . any)))) - (if (if #{tmp\ 2347}# + (lambda (#{a 2345}# #{b 2346}#) + (#{req 2323}# + #{b 2346}# + (cons #{a 2345}# #{rreq 2333}#))) + #{tmp 2338}#) + (let ((#{tmp 2347}# + ($sc-dispatch #{tmp 2336}# '(any . any)))) + (if (if #{tmp 2347}# (@apply - (lambda (#{a\ 2350}# #{b\ 2351}#) - (eq? (syntax->datum #{a\ 2350}#) + (lambda (#{a 2350}# #{b 2351}#) + (eq? (syntax->datum #{a 2350}#) #:optional)) - #{tmp\ 2347}#) + #{tmp 2347}#) #f) (@apply - (lambda (#{a\ 2354}# #{b\ 2355}#) - (#{opt\ 2325}# - #{b\ 2355}# - (reverse #{rreq\ 2333}#) + (lambda (#{a 2354}# #{b 2355}#) + (#{opt 2325}# + #{b 2355}# + (reverse #{rreq 2333}#) '())) - #{tmp\ 2347}#) - (let ((#{tmp\ 2356}# + #{tmp 2347}#) + (let ((#{tmp 2356}# ($sc-dispatch - #{tmp\ 2336}# + #{tmp 2336}# '(any . any)))) - (if (if #{tmp\ 2356}# + (if (if #{tmp 2356}# (@apply - (lambda (#{a\ 2359}# #{b\ 2360}#) - (eq? (syntax->datum #{a\ 2359}#) + (lambda (#{a 2359}# #{b 2360}#) + (eq? (syntax->datum #{a 2359}#) #:key)) - #{tmp\ 2356}#) + #{tmp 2356}#) #f) (@apply - (lambda (#{a\ 2363}# #{b\ 2364}#) - (#{key\ 2327}# - #{b\ 2364}# - (reverse #{rreq\ 2333}#) + (lambda (#{a 2363}# #{b 2364}#) + (#{key 2327}# + #{b 2364}# + (reverse #{rreq 2333}#) '() '())) - #{tmp\ 2356}#) - (let ((#{tmp\ 2365}# + #{tmp 2356}#) + (let ((#{tmp 2365}# ($sc-dispatch - #{tmp\ 2336}# + #{tmp 2336}# '(any any)))) - (if (if #{tmp\ 2365}# + (if (if #{tmp 2365}# (@apply - (lambda (#{a\ 2368}# #{b\ 2369}#) - (eq? (syntax->datum - #{a\ 2368}#) + (lambda (#{a 2368}# #{b 2369}#) + (eq? (syntax->datum #{a 2368}#) #:rest)) - #{tmp\ 2365}#) + #{tmp 2365}#) #f) (@apply - (lambda (#{a\ 2372}# #{b\ 2373}#) - (#{rest\ 2329}# - #{b\ 2373}# - (reverse #{rreq\ 2333}#) + (lambda (#{a 2372}# #{b 2373}#) + (#{rest 2329}# + #{b 2373}# + (reverse #{rreq 2333}#) '() '())) - #{tmp\ 2365}#) - (let ((#{tmp\ 2374}# - (list #{tmp\ 2336}#))) - (if (if #{tmp\ 2374}# + #{tmp 2365}#) + (let ((#{tmp 2374}# + (list #{tmp 2336}#))) + (if (if #{tmp 2374}# (@apply - (lambda (#{r\ 2376}#) - (#{id?\ 376}# #{r\ 2376}#)) - #{tmp\ 2374}#) + (lambda (#{r 2376}#) + (#{id? 376}# #{r 2376}#)) + #{tmp 2374}#) #f) (@apply - (lambda (#{r\ 2378}#) - (#{rest\ 2329}# - #{r\ 2378}# - (reverse #{rreq\ 2333}#) + (lambda (#{r 2378}#) + (#{rest 2329}# + #{r 2378}# + (reverse #{rreq 2333}#) '() '())) - #{tmp\ 2374}#) - (let ((#{else\ 2380}# - #{tmp\ 2336}#)) + #{tmp 2374}#) + (let ((#{else 2380}# #{tmp 2336}#)) (syntax-violation 'lambda* "invalid argument list" - #{orig-args\ 2320}# - #{args\ 2332}#))))))))))))))))) - (#{opt\ 2325}# - (lambda (#{args\ 2381}# #{req\ 2382}# #{ropt\ 2383}#) - (let ((#{tmp\ 2387}# #{args\ 2381}#)) - (let ((#{tmp\ 2388}# ($sc-dispatch #{tmp\ 2387}# '()))) - (if #{tmp\ 2388}# + #{orig-args 2320}# + #{args 2332}#))))))))))))))))) + (#{opt 2325}# + (lambda (#{args 2381}# #{req 2382}# #{ropt 2383}#) + (let ((#{tmp 2387}# #{args 2381}#)) + (let ((#{tmp 2388}# ($sc-dispatch #{tmp 2387}# '()))) + (if #{tmp 2388}# (@apply (lambda () - (#{check\ 2331}# - #{req\ 2382}# - (reverse #{ropt\ 2383}#) + (#{check 2331}# + #{req 2382}# + (reverse #{ropt 2383}#) #f '())) - #{tmp\ 2388}#) - (let ((#{tmp\ 2389}# - ($sc-dispatch #{tmp\ 2387}# '(any . any)))) - (if (if #{tmp\ 2389}# + #{tmp 2388}#) + (let ((#{tmp 2389}# + ($sc-dispatch #{tmp 2387}# '(any . any)))) + (if (if #{tmp 2389}# (@apply - (lambda (#{a\ 2392}# #{b\ 2393}#) - (#{id?\ 376}# #{a\ 2392}#)) - #{tmp\ 2389}#) + (lambda (#{a 2392}# #{b 2393}#) + (#{id? 376}# #{a 2392}#)) + #{tmp 2389}#) #f) (@apply - (lambda (#{a\ 2396}# #{b\ 2397}#) - (#{opt\ 2325}# - #{b\ 2397}# - #{req\ 2382}# - (cons (cons #{a\ 2396}# + (lambda (#{a 2396}# #{b 2397}#) + (#{opt 2325}# + #{b 2397}# + #{req 2382}# + (cons (cons #{a 2396}# '(#(syntax-object #f ((top) @@ -7553,128 +7531,124 @@ "i39" "i37"))) (hygiene guile)))) - #{ropt\ 2383}#))) - #{tmp\ 2389}#) - (let ((#{tmp\ 2398}# + #{ropt 2383}#))) + #{tmp 2389}#) + (let ((#{tmp 2398}# ($sc-dispatch - #{tmp\ 2387}# + #{tmp 2387}# '((any any) . any)))) - (if (if #{tmp\ 2398}# + (if (if #{tmp 2398}# (@apply - (lambda (#{a\ 2402}# - #{init\ 2403}# - #{b\ 2404}#) - (#{id?\ 376}# #{a\ 2402}#)) - #{tmp\ 2398}#) + (lambda (#{a 2402}# + #{init 2403}# + #{b 2404}#) + (#{id? 376}# #{a 2402}#)) + #{tmp 2398}#) #f) (@apply - (lambda (#{a\ 2408}# - #{init\ 2409}# - #{b\ 2410}#) - (#{opt\ 2325}# - #{b\ 2410}# - #{req\ 2382}# - (cons (list #{a\ 2408}# #{init\ 2409}#) - #{ropt\ 2383}#))) - #{tmp\ 2398}#) - (let ((#{tmp\ 2411}# + (lambda (#{a 2408}# #{init 2409}# #{b 2410}#) + (#{opt 2325}# + #{b 2410}# + #{req 2382}# + (cons (list #{a 2408}# #{init 2409}#) + #{ropt 2383}#))) + #{tmp 2398}#) + (let ((#{tmp 2411}# ($sc-dispatch - #{tmp\ 2387}# + #{tmp 2387}# '(any . any)))) - (if (if #{tmp\ 2411}# + (if (if #{tmp 2411}# (@apply - (lambda (#{a\ 2414}# #{b\ 2415}#) - (eq? (syntax->datum #{a\ 2414}#) + (lambda (#{a 2414}# #{b 2415}#) + (eq? (syntax->datum #{a 2414}#) #:key)) - #{tmp\ 2411}#) + #{tmp 2411}#) #f) (@apply - (lambda (#{a\ 2418}# #{b\ 2419}#) - (#{key\ 2327}# - #{b\ 2419}# - #{req\ 2382}# - (reverse #{ropt\ 2383}#) + (lambda (#{a 2418}# #{b 2419}#) + (#{key 2327}# + #{b 2419}# + #{req 2382}# + (reverse #{ropt 2383}#) '())) - #{tmp\ 2411}#) - (let ((#{tmp\ 2420}# + #{tmp 2411}#) + (let ((#{tmp 2420}# ($sc-dispatch - #{tmp\ 2387}# + #{tmp 2387}# '(any any)))) - (if (if #{tmp\ 2420}# + (if (if #{tmp 2420}# (@apply - (lambda (#{a\ 2423}# #{b\ 2424}#) - (eq? (syntax->datum - #{a\ 2423}#) + (lambda (#{a 2423}# #{b 2424}#) + (eq? (syntax->datum #{a 2423}#) #:rest)) - #{tmp\ 2420}#) + #{tmp 2420}#) #f) (@apply - (lambda (#{a\ 2427}# #{b\ 2428}#) - (#{rest\ 2329}# - #{b\ 2428}# - #{req\ 2382}# - (reverse #{ropt\ 2383}#) + (lambda (#{a 2427}# #{b 2428}#) + (#{rest 2329}# + #{b 2428}# + #{req 2382}# + (reverse #{ropt 2383}#) '())) - #{tmp\ 2420}#) - (let ((#{tmp\ 2429}# - (list #{tmp\ 2387}#))) - (if (if #{tmp\ 2429}# + #{tmp 2420}#) + (let ((#{tmp 2429}# + (list #{tmp 2387}#))) + (if (if #{tmp 2429}# (@apply - (lambda (#{r\ 2431}#) - (#{id?\ 376}# #{r\ 2431}#)) - #{tmp\ 2429}#) + (lambda (#{r 2431}#) + (#{id? 376}# #{r 2431}#)) + #{tmp 2429}#) #f) (@apply - (lambda (#{r\ 2433}#) - (#{rest\ 2329}# - #{r\ 2433}# - #{req\ 2382}# - (reverse #{ropt\ 2383}#) + (lambda (#{r 2433}#) + (#{rest 2329}# + #{r 2433}# + #{req 2382}# + (reverse #{ropt 2383}#) '())) - #{tmp\ 2429}#) - (let ((#{else\ 2435}# - #{tmp\ 2387}#)) + #{tmp 2429}#) + (let ((#{else 2435}# #{tmp 2387}#)) (syntax-violation 'lambda* "invalid optional argument list" - #{orig-args\ 2320}# - #{args\ 2381}#))))))))))))))))) - (#{key\ 2327}# - (lambda (#{args\ 2436}# - #{req\ 2437}# - #{opt\ 2438}# - #{rkey\ 2439}#) - (let ((#{tmp\ 2444}# #{args\ 2436}#)) - (let ((#{tmp\ 2445}# ($sc-dispatch #{tmp\ 2444}# '()))) - (if #{tmp\ 2445}# + #{orig-args 2320}# + #{args 2381}#))))))))))))))))) + (#{key 2327}# + (lambda (#{args 2436}# + #{req 2437}# + #{opt 2438}# + #{rkey 2439}#) + (let ((#{tmp 2444}# #{args 2436}#)) + (let ((#{tmp 2445}# ($sc-dispatch #{tmp 2444}# '()))) + (if #{tmp 2445}# (@apply (lambda () - (#{check\ 2331}# - #{req\ 2437}# - #{opt\ 2438}# + (#{check 2331}# + #{req 2437}# + #{opt 2438}# #f - (cons #f (reverse #{rkey\ 2439}#)))) - #{tmp\ 2445}#) - (let ((#{tmp\ 2446}# - ($sc-dispatch #{tmp\ 2444}# '(any . any)))) - (if (if #{tmp\ 2446}# + (cons #f (reverse #{rkey 2439}#)))) + #{tmp 2445}#) + (let ((#{tmp 2446}# + ($sc-dispatch #{tmp 2444}# '(any . any)))) + (if (if #{tmp 2446}# (@apply - (lambda (#{a\ 2449}# #{b\ 2450}#) - (#{id?\ 376}# #{a\ 2449}#)) - #{tmp\ 2446}#) + (lambda (#{a 2449}# #{b 2450}#) + (#{id? 376}# #{a 2449}#)) + #{tmp 2446}#) #f) (@apply - (lambda (#{a\ 2453}# #{b\ 2454}#) - (let ((#{tmp\ 2456}# + (lambda (#{a 2453}# #{b 2454}#) + (let ((#{tmp 2456}# (symbol->keyword - (syntax->datum #{a\ 2453}#)))) - (let ((#{k\ 2458}# #{tmp\ 2456}#)) - (#{key\ 2327}# - #{b\ 2454}# - #{req\ 2437}# - #{opt\ 2438}# - (cons (cons #{k\ 2458}# - (cons #{a\ 2453}# + (syntax->datum #{a 2453}#)))) + (let ((#{k 2458}# #{tmp 2456}#)) + (#{key 2327}# + #{b 2454}# + #{req 2437}# + #{opt 2438}# + (cons (cons #{k 2458}# + (cons #{a 2453}# '(#(syntax-object #f ((top) @@ -8150,2001 +8124,1970 @@ "i39" "i37"))) (hygiene guile))))) - #{rkey\ 2439}#))))) - #{tmp\ 2446}#) - (let ((#{tmp\ 2459}# + #{rkey 2439}#))))) + #{tmp 2446}#) + (let ((#{tmp 2459}# ($sc-dispatch - #{tmp\ 2444}# + #{tmp 2444}# '((any any) . any)))) - (if (if #{tmp\ 2459}# + (if (if #{tmp 2459}# (@apply - (lambda (#{a\ 2463}# - #{init\ 2464}# - #{b\ 2465}#) - (#{id?\ 376}# #{a\ 2463}#)) - #{tmp\ 2459}#) + (lambda (#{a 2463}# + #{init 2464}# + #{b 2465}#) + (#{id? 376}# #{a 2463}#)) + #{tmp 2459}#) #f) (@apply - (lambda (#{a\ 2469}# - #{init\ 2470}# - #{b\ 2471}#) - (let ((#{tmp\ 2473}# + (lambda (#{a 2469}# #{init 2470}# #{b 2471}#) + (let ((#{tmp 2473}# (symbol->keyword - (syntax->datum #{a\ 2469}#)))) - (let ((#{k\ 2475}# #{tmp\ 2473}#)) - (#{key\ 2327}# - #{b\ 2471}# - #{req\ 2437}# - #{opt\ 2438}# - (cons (list #{k\ 2475}# - #{a\ 2469}# - #{init\ 2470}#) - #{rkey\ 2439}#))))) - #{tmp\ 2459}#) - (let ((#{tmp\ 2476}# + (syntax->datum #{a 2469}#)))) + (let ((#{k 2475}# #{tmp 2473}#)) + (#{key 2327}# + #{b 2471}# + #{req 2437}# + #{opt 2438}# + (cons (list #{k 2475}# + #{a 2469}# + #{init 2470}#) + #{rkey 2439}#))))) + #{tmp 2459}#) + (let ((#{tmp 2476}# ($sc-dispatch - #{tmp\ 2444}# + #{tmp 2444}# '((any any any) . any)))) - (if (if #{tmp\ 2476}# + (if (if #{tmp 2476}# (@apply - (lambda (#{a\ 2481}# - #{init\ 2482}# - #{k\ 2483}# - #{b\ 2484}#) - (if (#{id?\ 376}# #{a\ 2481}#) + (lambda (#{a 2481}# + #{init 2482}# + #{k 2483}# + #{b 2484}#) + (if (#{id? 376}# #{a 2481}#) (keyword? - (syntax->datum #{k\ 2483}#)) + (syntax->datum #{k 2483}#)) #f)) - #{tmp\ 2476}#) + #{tmp 2476}#) #f) (@apply - (lambda (#{a\ 2491}# - #{init\ 2492}# - #{k\ 2493}# - #{b\ 2494}#) - (#{key\ 2327}# - #{b\ 2494}# - #{req\ 2437}# - #{opt\ 2438}# - (cons (list #{k\ 2493}# - #{a\ 2491}# - #{init\ 2492}#) - #{rkey\ 2439}#))) - #{tmp\ 2476}#) - (let ((#{tmp\ 2495}# + (lambda (#{a 2491}# + #{init 2492}# + #{k 2493}# + #{b 2494}#) + (#{key 2327}# + #{b 2494}# + #{req 2437}# + #{opt 2438}# + (cons (list #{k 2493}# + #{a 2491}# + #{init 2492}#) + #{rkey 2439}#))) + #{tmp 2476}#) + (let ((#{tmp 2495}# ($sc-dispatch - #{tmp\ 2444}# + #{tmp 2444}# '(any)))) - (if (if #{tmp\ 2495}# + (if (if #{tmp 2495}# (@apply - (lambda (#{aok\ 2497}#) + (lambda (#{aok 2497}#) (eq? (syntax->datum - #{aok\ 2497}#) + #{aok 2497}#) #:allow-other-keys)) - #{tmp\ 2495}#) + #{tmp 2495}#) #f) (@apply - (lambda (#{aok\ 2499}#) - (#{check\ 2331}# - #{req\ 2437}# - #{opt\ 2438}# + (lambda (#{aok 2499}#) + (#{check 2331}# + #{req 2437}# + #{opt 2438}# #f (cons #t - (reverse #{rkey\ 2439}#)))) - #{tmp\ 2495}#) - (let ((#{tmp\ 2500}# + (reverse #{rkey 2439}#)))) + #{tmp 2495}#) + (let ((#{tmp 2500}# ($sc-dispatch - #{tmp\ 2444}# + #{tmp 2444}# '(any any any)))) - (if (if #{tmp\ 2500}# + (if (if #{tmp 2500}# (@apply - (lambda (#{aok\ 2504}# - #{a\ 2505}# - #{b\ 2506}#) + (lambda (#{aok 2504}# + #{a 2505}# + #{b 2506}#) (if (eq? (syntax->datum - #{aok\ 2504}#) + #{aok 2504}#) #:allow-other-keys) (eq? (syntax->datum - #{a\ 2505}#) + #{a 2505}#) #:rest) #f)) - #{tmp\ 2500}#) + #{tmp 2500}#) #f) (@apply - (lambda (#{aok\ 2512}# - #{a\ 2513}# - #{b\ 2514}#) - (#{rest\ 2329}# - #{b\ 2514}# - #{req\ 2437}# - #{opt\ 2438}# + (lambda (#{aok 2512}# + #{a 2513}# + #{b 2514}#) + (#{rest 2329}# + #{b 2514}# + #{req 2437}# + #{opt 2438}# (cons #t (reverse - #{rkey\ 2439}#)))) - #{tmp\ 2500}#) - (let ((#{tmp\ 2515}# + #{rkey 2439}#)))) + #{tmp 2500}#) + (let ((#{tmp 2515}# ($sc-dispatch - #{tmp\ 2444}# + #{tmp 2444}# '(any . any)))) - (if (if #{tmp\ 2515}# + (if (if #{tmp 2515}# (@apply - (lambda (#{aok\ 2518}# - #{r\ 2519}#) + (lambda (#{aok 2518}# + #{r 2519}#) (if (eq? (syntax->datum - #{aok\ 2518}#) + #{aok 2518}#) #:allow-other-keys) - (#{id?\ 376}# - #{r\ 2519}#) + (#{id? 376}# + #{r 2519}#) #f)) - #{tmp\ 2515}#) + #{tmp 2515}#) #f) (@apply - (lambda (#{aok\ 2524}# - #{r\ 2525}#) - (#{rest\ 2329}# - #{r\ 2525}# - #{req\ 2437}# - #{opt\ 2438}# + (lambda (#{aok 2524}# + #{r 2525}#) + (#{rest 2329}# + #{r 2525}# + #{req 2437}# + #{opt 2438}# (cons #t (reverse - #{rkey\ 2439}#)))) - #{tmp\ 2515}#) - (let ((#{tmp\ 2526}# + #{rkey 2439}#)))) + #{tmp 2515}#) + (let ((#{tmp 2526}# ($sc-dispatch - #{tmp\ 2444}# + #{tmp 2444}# '(any any)))) - (if (if #{tmp\ 2526}# + (if (if #{tmp 2526}# (@apply - (lambda (#{a\ 2529}# - #{b\ 2530}#) + (lambda (#{a 2529}# + #{b 2530}#) (eq? (syntax->datum - #{a\ 2529}#) + #{a 2529}#) #:rest)) - #{tmp\ 2526}#) + #{tmp 2526}#) #f) (@apply - (lambda (#{a\ 2533}# - #{b\ 2534}#) - (#{rest\ 2329}# - #{b\ 2534}# - #{req\ 2437}# - #{opt\ 2438}# + (lambda (#{a 2533}# + #{b 2534}#) + (#{rest 2329}# + #{b 2534}# + #{req 2437}# + #{opt 2438}# (cons #f (reverse - #{rkey\ 2439}#)))) - #{tmp\ 2526}#) - (let ((#{tmp\ 2535}# - (list #{tmp\ 2444}#))) - (if (if #{tmp\ 2535}# + #{rkey 2439}#)))) + #{tmp 2526}#) + (let ((#{tmp 2535}# + (list #{tmp 2444}#))) + (if (if #{tmp 2535}# (@apply - (lambda (#{r\ 2537}#) - (#{id?\ 376}# - #{r\ 2537}#)) - #{tmp\ 2535}#) + (lambda (#{r 2537}#) + (#{id? 376}# + #{r 2537}#)) + #{tmp 2535}#) #f) (@apply - (lambda (#{r\ 2539}#) - (#{rest\ 2329}# - #{r\ 2539}# - #{req\ 2437}# - #{opt\ 2438}# + (lambda (#{r 2539}#) + (#{rest 2329}# + #{r 2539}# + #{req 2437}# + #{opt 2438}# (cons #f (reverse - #{rkey\ 2439}#)))) - #{tmp\ 2535}#) - (let ((#{else\ 2541}# - #{tmp\ 2444}#)) + #{rkey 2439}#)))) + #{tmp 2535}#) + (let ((#{else 2541}# + #{tmp 2444}#)) (syntax-violation 'lambda* "invalid keyword argument list" - #{orig-args\ 2320}# - #{args\ 2436}#))))))))))))))))))))))) - (#{rest\ 2329}# - (lambda (#{args\ 2542}# - #{req\ 2543}# - #{opt\ 2544}# - #{kw\ 2545}#) - (let ((#{tmp\ 2550}# #{args\ 2542}#)) - (let ((#{tmp\ 2551}# (list #{tmp\ 2550}#))) - (if (if #{tmp\ 2551}# + #{orig-args 2320}# + #{args 2436}#))))))))))))))))))))))) + (#{rest 2329}# + (lambda (#{args 2542}# + #{req 2543}# + #{opt 2544}# + #{kw 2545}#) + (let ((#{tmp 2550}# #{args 2542}#)) + (let ((#{tmp 2551}# (list #{tmp 2550}#))) + (if (if #{tmp 2551}# (@apply - (lambda (#{r\ 2553}#) (#{id?\ 376}# #{r\ 2553}#)) - #{tmp\ 2551}#) + (lambda (#{r 2553}#) (#{id? 376}# #{r 2553}#)) + #{tmp 2551}#) #f) (@apply - (lambda (#{r\ 2555}#) - (#{check\ 2331}# - #{req\ 2543}# - #{opt\ 2544}# - #{r\ 2555}# - #{kw\ 2545}#)) - #{tmp\ 2551}#) - (let ((#{else\ 2557}# #{tmp\ 2550}#)) + (lambda (#{r 2555}#) + (#{check 2331}# + #{req 2543}# + #{opt 2544}# + #{r 2555}# + #{kw 2545}#)) + #{tmp 2551}#) + (let ((#{else 2557}# #{tmp 2550}#)) (syntax-violation 'lambda* "invalid rest argument" - #{orig-args\ 2320}# - #{args\ 2542}#))))))) - (#{check\ 2331}# - (lambda (#{req\ 2558}# - #{opt\ 2559}# - #{rest\ 2560}# - #{kw\ 2561}#) - (if (#{distinct-bound-ids?\ 438}# + #{orig-args 2320}# + #{args 2542}#))))))) + (#{check 2331}# + (lambda (#{req 2558}# + #{opt 2559}# + #{rest 2560}# + #{kw 2561}#) + (if (#{distinct-bound-ids? 438}# (append - #{req\ 2558}# - (map car #{opt\ 2559}#) - (if #{rest\ 2560}# (list #{rest\ 2560}#) '()) - (if (pair? #{kw\ 2561}#) - (map cadr (cdr #{kw\ 2561}#)) + #{req 2558}# + (map car #{opt 2559}#) + (if #{rest 2560}# (list #{rest 2560}#) '()) + (if (pair? #{kw 2561}#) + (map cadr (cdr #{kw 2561}#)) '()))) (values - #{req\ 2558}# - #{opt\ 2559}# - #{rest\ 2560}# - #{kw\ 2561}#) + #{req 2558}# + #{opt 2559}# + #{rest 2560}# + #{kw 2561}#) (syntax-violation 'lambda* "duplicate identifier in argument list" - #{orig-args\ 2320}#))))) - (begin (#{req\ 2323}# #{orig-args\ 2320}# '()))))) - (#{chi-lambda-case\ 480}# - (lambda (#{e\ 2569}# - #{r\ 2570}# - #{w\ 2571}# - #{s\ 2572}# - #{mod\ 2573}# - #{get-formals\ 2574}# - #{clauses\ 2575}#) + #{orig-args 2320}#))))) + (begin (#{req 2323}# #{orig-args 2320}# '()))))) + (#{chi-lambda-case 480}# + (lambda (#{e 2569}# + #{r 2570}# + #{w 2571}# + #{s 2572}# + #{mod 2573}# + #{get-formals 2574}# + #{clauses 2575}#) (letrec* - ((#{expand-req\ 2584}# - (lambda (#{req\ 2591}# - #{opt\ 2592}# - #{rest\ 2593}# - #{kw\ 2594}# - #{body\ 2595}#) + ((#{expand-req 2584}# + (lambda (#{req 2591}# + #{opt 2592}# + #{rest 2593}# + #{kw 2594}# + #{body 2595}#) (begin - (let ((#{vars\ 2603}# - (map #{gen-var\ 484}# #{req\ 2591}#)) - (#{labels\ 2604}# - (#{gen-labels\ 391}# #{req\ 2591}#))) + (let ((#{vars 2603}# + (map #{gen-var 484}# #{req 2591}#)) + (#{labels 2604}# + (#{gen-labels 391}# #{req 2591}#))) (begin - (let ((#{r*\ 2607}# - (#{extend-var-env\ 366}# - #{labels\ 2604}# - #{vars\ 2603}# - #{r\ 2570}#)) - (#{w*\ 2608}# - (#{make-binding-wrap\ 420}# - #{req\ 2591}# - #{labels\ 2604}# - #{w\ 2571}#))) - (#{expand-opt\ 2586}# - (map syntax->datum #{req\ 2591}#) - #{opt\ 2592}# - #{rest\ 2593}# - #{kw\ 2594}# - #{body\ 2595}# - (reverse #{vars\ 2603}#) - #{r*\ 2607}# - #{w*\ 2608}# + (let ((#{r* 2607}# + (#{extend-var-env 366}# + #{labels 2604}# + #{vars 2603}# + #{r 2570}#)) + (#{w* 2608}# + (#{make-binding-wrap 420}# + #{req 2591}# + #{labels 2604}# + #{w 2571}#))) + (#{expand-opt 2586}# + (map syntax->datum #{req 2591}#) + #{opt 2592}# + #{rest 2593}# + #{kw 2594}# + #{body 2595}# + (reverse #{vars 2603}#) + #{r* 2607}# + #{w* 2608}# '() '()))))))) - (#{expand-opt\ 2586}# - (lambda (#{req\ 2609}# - #{opt\ 2610}# - #{rest\ 2611}# - #{kw\ 2612}# - #{body\ 2613}# - #{vars\ 2614}# - #{r*\ 2615}# - #{w*\ 2616}# - #{out\ 2617}# - #{inits\ 2618}#) - (if (pair? #{opt\ 2610}#) - (let ((#{tmp\ 2631}# (car #{opt\ 2610}#))) - (let ((#{tmp\ 2632}# - ($sc-dispatch #{tmp\ 2631}# '(any any)))) - (if #{tmp\ 2632}# + (#{expand-opt 2586}# + (lambda (#{req 2609}# + #{opt 2610}# + #{rest 2611}# + #{kw 2612}# + #{body 2613}# + #{vars 2614}# + #{r* 2615}# + #{w* 2616}# + #{out 2617}# + #{inits 2618}#) + (if (pair? #{opt 2610}#) + (let ((#{tmp 2631}# (car #{opt 2610}#))) + (let ((#{tmp 2632}# + ($sc-dispatch #{tmp 2631}# '(any any)))) + (if #{tmp 2632}# (@apply - (lambda (#{id\ 2635}# #{i\ 2636}#) + (lambda (#{id 2635}# #{i 2636}#) (begin - (let ((#{v\ 2639}# - (#{gen-var\ 484}# #{id\ 2635}#))) + (let ((#{v 2639}# + (#{gen-var 484}# #{id 2635}#))) (begin - (let ((#{l\ 2641}# - (#{gen-labels\ 391}# - (list #{v\ 2639}#)))) + (let ((#{l 2641}# + (#{gen-labels 391}# + (list #{v 2639}#)))) (begin - (let ((#{r**\ 2643}# - (#{extend-var-env\ 366}# - #{l\ 2641}# - (list #{v\ 2639}#) - #{r*\ 2615}#))) + (let ((#{r** 2643}# + (#{extend-var-env 366}# + #{l 2641}# + (list #{v 2639}#) + #{r* 2615}#))) (begin - (let ((#{w**\ 2645}# - (#{make-binding-wrap\ 420}# - (list #{id\ 2635}#) - #{l\ 2641}# - #{w*\ 2616}#))) - (#{expand-opt\ 2586}# - #{req\ 2609}# - (cdr #{opt\ 2610}#) - #{rest\ 2611}# - #{kw\ 2612}# - #{body\ 2613}# - (cons #{v\ 2639}# - #{vars\ 2614}#) - #{r**\ 2643}# - #{w**\ 2645}# + (let ((#{w** 2645}# + (#{make-binding-wrap 420}# + (list #{id 2635}#) + #{l 2641}# + #{w* 2616}#))) + (#{expand-opt 2586}# + #{req 2609}# + (cdr #{opt 2610}#) + #{rest 2611}# + #{kw 2612}# + #{body 2613}# + (cons #{v 2639}# #{vars 2614}#) + #{r** 2643}# + #{w** 2645}# (cons (syntax->datum - #{id\ 2635}#) - #{out\ 2617}#) - (cons (#{chi\ 456}# - #{i\ 2636}# - #{r*\ 2615}# - #{w*\ 2616}# - #{mod\ 2573}#) - #{inits\ 2618}#))))))))))) - #{tmp\ 2632}#) + #{id 2635}#) + #{out 2617}#) + (cons (#{chi 456}# + #{i 2636}# + #{r* 2615}# + #{w* 2616}# + #{mod 2573}#) + #{inits 2618}#))))))))))) + #{tmp 2632}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2631}#)))) - (if #{rest\ 2611}# + #{tmp 2631}#)))) + (if #{rest 2611}# (begin - (let ((#{v\ 2650}# (#{gen-var\ 484}# #{rest\ 2611}#))) + (let ((#{v 2650}# (#{gen-var 484}# #{rest 2611}#))) (begin - (let ((#{l\ 2652}# - (#{gen-labels\ 391}# (list #{v\ 2650}#)))) + (let ((#{l 2652}# + (#{gen-labels 391}# (list #{v 2650}#)))) (begin - (let ((#{r*\ 2654}# - (#{extend-var-env\ 366}# - #{l\ 2652}# - (list #{v\ 2650}#) - #{r*\ 2615}#))) + (let ((#{r* 2654}# + (#{extend-var-env 366}# + #{l 2652}# + (list #{v 2650}#) + #{r* 2615}#))) (begin - (let ((#{w*\ 2656}# - (#{make-binding-wrap\ 420}# - (list #{rest\ 2611}#) - #{l\ 2652}# - #{w*\ 2616}#))) - (#{expand-kw\ 2588}# - #{req\ 2609}# - (if (pair? #{out\ 2617}#) - (reverse #{out\ 2617}#) + (let ((#{w* 2656}# + (#{make-binding-wrap 420}# + (list #{rest 2611}#) + #{l 2652}# + #{w* 2616}#))) + (#{expand-kw 2588}# + #{req 2609}# + (if (pair? #{out 2617}#) + (reverse #{out 2617}#) #f) - (syntax->datum #{rest\ 2611}#) - (if (pair? #{kw\ 2612}#) - (cdr #{kw\ 2612}#) - #{kw\ 2612}#) - #{body\ 2613}# - (cons #{v\ 2650}# #{vars\ 2614}#) - #{r*\ 2654}# - #{w*\ 2656}# - (if (pair? #{kw\ 2612}#) - (car #{kw\ 2612}#) + (syntax->datum #{rest 2611}#) + (if (pair? #{kw 2612}#) + (cdr #{kw 2612}#) + #{kw 2612}#) + #{body 2613}# + (cons #{v 2650}# #{vars 2614}#) + #{r* 2654}# + #{w* 2656}# + (if (pair? #{kw 2612}#) + (car #{kw 2612}#) #f) '() - #{inits\ 2618}#))))))))) - (#{expand-kw\ 2588}# - #{req\ 2609}# - (if (pair? #{out\ 2617}#) - (reverse #{out\ 2617}#) + #{inits 2618}#))))))))) + (#{expand-kw 2588}# + #{req 2609}# + (if (pair? #{out 2617}#) + (reverse #{out 2617}#) #f) #f - (if (pair? #{kw\ 2612}#) - (cdr #{kw\ 2612}#) - #{kw\ 2612}#) - #{body\ 2613}# - #{vars\ 2614}# - #{r*\ 2615}# - #{w*\ 2616}# - (if (pair? #{kw\ 2612}#) (car #{kw\ 2612}#) #f) + (if (pair? #{kw 2612}#) + (cdr #{kw 2612}#) + #{kw 2612}#) + #{body 2613}# + #{vars 2614}# + #{r* 2615}# + #{w* 2616}# + (if (pair? #{kw 2612}#) (car #{kw 2612}#) #f) '() - #{inits\ 2618}#))))) - (#{expand-kw\ 2588}# - (lambda (#{req\ 2658}# - #{opt\ 2659}# - #{rest\ 2660}# - #{kw\ 2661}# - #{body\ 2662}# - #{vars\ 2663}# - #{r*\ 2664}# - #{w*\ 2665}# - #{aok\ 2666}# - #{out\ 2667}# - #{inits\ 2668}#) - (if (pair? #{kw\ 2661}#) - (let ((#{tmp\ 2682}# (car #{kw\ 2661}#))) - (let ((#{tmp\ 2683}# - ($sc-dispatch #{tmp\ 2682}# '(any any any)))) - (if #{tmp\ 2683}# + #{inits 2618}#))))) + (#{expand-kw 2588}# + (lambda (#{req 2658}# + #{opt 2659}# + #{rest 2660}# + #{kw 2661}# + #{body 2662}# + #{vars 2663}# + #{r* 2664}# + #{w* 2665}# + #{aok 2666}# + #{out 2667}# + #{inits 2668}#) + (if (pair? #{kw 2661}#) + (let ((#{tmp 2682}# (car #{kw 2661}#))) + (let ((#{tmp 2683}# + ($sc-dispatch #{tmp 2682}# '(any any any)))) + (if #{tmp 2683}# (@apply - (lambda (#{k\ 2687}# #{id\ 2688}# #{i\ 2689}#) + (lambda (#{k 2687}# #{id 2688}# #{i 2689}#) (begin - (let ((#{v\ 2692}# - (#{gen-var\ 484}# #{id\ 2688}#))) + (let ((#{v 2692}# + (#{gen-var 484}# #{id 2688}#))) (begin - (let ((#{l\ 2694}# - (#{gen-labels\ 391}# - (list #{v\ 2692}#)))) + (let ((#{l 2694}# + (#{gen-labels 391}# + (list #{v 2692}#)))) (begin - (let ((#{r**\ 2696}# - (#{extend-var-env\ 366}# - #{l\ 2694}# - (list #{v\ 2692}#) - #{r*\ 2664}#))) + (let ((#{r** 2696}# + (#{extend-var-env 366}# + #{l 2694}# + (list #{v 2692}#) + #{r* 2664}#))) (begin - (let ((#{w**\ 2698}# - (#{make-binding-wrap\ 420}# - (list #{id\ 2688}#) - #{l\ 2694}# - #{w*\ 2665}#))) - (#{expand-kw\ 2588}# - #{req\ 2658}# - #{opt\ 2659}# - #{rest\ 2660}# - (cdr #{kw\ 2661}#) - #{body\ 2662}# - (cons #{v\ 2692}# - #{vars\ 2663}#) - #{r**\ 2696}# - #{w**\ 2698}# - #{aok\ 2666}# + (let ((#{w** 2698}# + (#{make-binding-wrap 420}# + (list #{id 2688}#) + #{l 2694}# + #{w* 2665}#))) + (#{expand-kw 2588}# + #{req 2658}# + #{opt 2659}# + #{rest 2660}# + (cdr #{kw 2661}#) + #{body 2662}# + (cons #{v 2692}# #{vars 2663}#) + #{r** 2696}# + #{w** 2698}# + #{aok 2666}# (cons (list (syntax->datum - #{k\ 2687}#) + #{k 2687}#) (syntax->datum - #{id\ 2688}#) - #{v\ 2692}#) - #{out\ 2667}#) - (cons (#{chi\ 456}# - #{i\ 2689}# - #{r*\ 2664}# - #{w*\ 2665}# - #{mod\ 2573}#) - #{inits\ 2668}#))))))))))) - #{tmp\ 2683}#) + #{id 2688}#) + #{v 2692}#) + #{out 2667}#) + (cons (#{chi 456}# + #{i 2689}# + #{r* 2664}# + #{w* 2665}# + #{mod 2573}#) + #{inits 2668}#))))))))))) + #{tmp 2683}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2682}#)))) - (#{expand-body\ 2590}# - #{req\ 2658}# - #{opt\ 2659}# - #{rest\ 2660}# + #{tmp 2682}#)))) + (#{expand-body 2590}# + #{req 2658}# + #{opt 2659}# + #{rest 2660}# (if (begin - (let ((#{t\ 2702}# #{aok\ 2666}#)) - (if #{t\ 2702}# - #{t\ 2702}# - (pair? #{out\ 2667}#)))) - (cons #{aok\ 2666}# (reverse #{out\ 2667}#)) + (let ((#{t 2702}# #{aok 2666}#)) + (if #{t 2702}# #{t 2702}# (pair? #{out 2667}#)))) + (cons #{aok 2666}# (reverse #{out 2667}#)) #f) - #{body\ 2662}# - (reverse #{vars\ 2663}#) - #{r*\ 2664}# - #{w*\ 2665}# - (reverse #{inits\ 2668}#) + #{body 2662}# + (reverse #{vars 2663}#) + #{r* 2664}# + #{w* 2665}# + (reverse #{inits 2668}#) '())))) - (#{expand-body\ 2590}# - (lambda (#{req\ 2704}# - #{opt\ 2705}# - #{rest\ 2706}# - #{kw\ 2707}# - #{body\ 2708}# - #{vars\ 2709}# - #{r*\ 2710}# - #{w*\ 2711}# - #{inits\ 2712}# - #{meta\ 2713}#) - (let ((#{tmp\ 2724}# #{body\ 2708}#)) - (let ((#{tmp\ 2725}# - ($sc-dispatch - #{tmp\ 2724}# - '(any any . each-any)))) - (if (if #{tmp\ 2725}# + (#{expand-body 2590}# + (lambda (#{req 2704}# + #{opt 2705}# + #{rest 2706}# + #{kw 2707}# + #{body 2708}# + #{vars 2709}# + #{r* 2710}# + #{w* 2711}# + #{inits 2712}# + #{meta 2713}#) + (let ((#{tmp 2724}# #{body 2708}#)) + (let ((#{tmp 2725}# + ($sc-dispatch #{tmp 2724}# '(any any . each-any)))) + (if (if #{tmp 2725}# (@apply - (lambda (#{docstring\ 2729}# - #{e1\ 2730}# - #{e2\ 2731}#) - (string? (syntax->datum #{docstring\ 2729}#))) - #{tmp\ 2725}#) + (lambda (#{docstring 2729}# + #{e1 2730}# + #{e2 2731}#) + (string? (syntax->datum #{docstring 2729}#))) + #{tmp 2725}#) #f) (@apply - (lambda (#{docstring\ 2735}# - #{e1\ 2736}# - #{e2\ 2737}#) - (#{expand-body\ 2590}# - #{req\ 2704}# - #{opt\ 2705}# - #{rest\ 2706}# - #{kw\ 2707}# - (cons #{e1\ 2736}# #{e2\ 2737}#) - #{vars\ 2709}# - #{r*\ 2710}# - #{w*\ 2711}# - #{inits\ 2712}# + (lambda (#{docstring 2735}# #{e1 2736}# #{e2 2737}#) + (#{expand-body 2590}# + #{req 2704}# + #{opt 2705}# + #{rest 2706}# + #{kw 2707}# + (cons #{e1 2736}# #{e2 2737}#) + #{vars 2709}# + #{r* 2710}# + #{w* 2711}# + #{inits 2712}# (append - #{meta\ 2713}# + #{meta 2713}# (list (cons 'documentation (syntax->datum - #{docstring\ 2735}#)))))) - #{tmp\ 2725}#) - (let ((#{tmp\ 2740}# + #{docstring 2735}#)))))) + #{tmp 2725}#) + (let ((#{tmp 2740}# ($sc-dispatch - #{tmp\ 2724}# + #{tmp 2724}# '(#(vector #(each (any . any))) any . each-any)))) - (if #{tmp\ 2740}# + (if #{tmp 2740}# (@apply - (lambda (#{k\ 2745}# - #{v\ 2746}# - #{e1\ 2747}# - #{e2\ 2748}#) - (#{expand-body\ 2590}# - #{req\ 2704}# - #{opt\ 2705}# - #{rest\ 2706}# - #{kw\ 2707}# - (cons #{e1\ 2747}# #{e2\ 2748}#) - #{vars\ 2709}# - #{r*\ 2710}# - #{w*\ 2711}# - #{inits\ 2712}# + (lambda (#{k 2745}# + #{v 2746}# + #{e1 2747}# + #{e2 2748}#) + (#{expand-body 2590}# + #{req 2704}# + #{opt 2705}# + #{rest 2706}# + #{kw 2707}# + (cons #{e1 2747}# #{e2 2748}#) + #{vars 2709}# + #{r* 2710}# + #{w* 2711}# + #{inits 2712}# (append - #{meta\ 2713}# + #{meta 2713}# (syntax->datum - (map cons #{k\ 2745}# #{v\ 2746}#))))) - #{tmp\ 2740}#) - (let ((#{tmp\ 2752}# + (map cons #{k 2745}# #{v 2746}#))))) + #{tmp 2740}#) + (let ((#{tmp 2752}# ($sc-dispatch - #{tmp\ 2724}# + #{tmp 2724}# '(any . each-any)))) - (if #{tmp\ 2752}# + (if #{tmp 2752}# (@apply - (lambda (#{e1\ 2755}# #{e2\ 2756}#) + (lambda (#{e1 2755}# #{e2 2756}#) (values - #{meta\ 2713}# - #{req\ 2704}# - #{opt\ 2705}# - #{rest\ 2706}# - #{kw\ 2707}# - #{inits\ 2712}# - #{vars\ 2709}# - (#{chi-body\ 464}# - (cons #{e1\ 2755}# #{e2\ 2756}#) - (#{source-wrap\ 444}# - #{e\ 2569}# - #{w\ 2571}# - #{s\ 2572}# - #{mod\ 2573}#) - #{r*\ 2710}# - #{w*\ 2711}# - #{mod\ 2573}#))) - #{tmp\ 2752}#) + #{meta 2713}# + #{req 2704}# + #{opt 2705}# + #{rest 2706}# + #{kw 2707}# + #{inits 2712}# + #{vars 2709}# + (#{chi-body 464}# + (cons #{e1 2755}# #{e2 2756}#) + (#{source-wrap 444}# + #{e 2569}# + #{w 2571}# + #{s 2572}# + #{mod 2573}#) + #{r* 2710}# + #{w* 2711}# + #{mod 2573}#))) + #{tmp 2752}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2724}#))))))))))) + #{tmp 2724}#))))))))))) (begin - (let ((#{tmp\ 2758}# #{clauses\ 2575}#)) - (let ((#{tmp\ 2759}# ($sc-dispatch #{tmp\ 2758}# '()))) - (if #{tmp\ 2759}# - (@apply - (lambda () (values '() #f)) - #{tmp\ 2759}#) - (let ((#{tmp\ 2760}# + (let ((#{tmp 2758}# #{clauses 2575}#)) + (let ((#{tmp 2759}# ($sc-dispatch #{tmp 2758}# '()))) + (if #{tmp 2759}# + (@apply (lambda () (values '() #f)) #{tmp 2759}#) + (let ((#{tmp 2760}# ($sc-dispatch - #{tmp\ 2758}# + #{tmp 2758}# '((any any . each-any) . #(each (any any . each-any)))))) - (if #{tmp\ 2760}# + (if #{tmp 2760}# (@apply - (lambda (#{args\ 2767}# - #{e1\ 2768}# - #{e2\ 2769}# - #{args*\ 2770}# - #{e1*\ 2771}# - #{e2*\ 2772}#) + (lambda (#{args 2767}# + #{e1 2768}# + #{e2 2769}# + #{args* 2770}# + #{e1* 2771}# + #{e2* 2772}#) (call-with-values - (lambda () - (#{get-formals\ 2574}# #{args\ 2767}#)) - (lambda (#{req\ 2773}# - #{opt\ 2774}# - #{rest\ 2775}# - #{kw\ 2776}#) + (lambda () (#{get-formals 2574}# #{args 2767}#)) + (lambda (#{req 2773}# + #{opt 2774}# + #{rest 2775}# + #{kw 2776}#) (call-with-values (lambda () - (#{expand-req\ 2584}# - #{req\ 2773}# - #{opt\ 2774}# - #{rest\ 2775}# - #{kw\ 2776}# - (cons #{e1\ 2768}# #{e2\ 2769}#))) - (lambda (#{meta\ 2782}# - #{req\ 2783}# - #{opt\ 2784}# - #{rest\ 2785}# - #{kw\ 2786}# - #{inits\ 2787}# - #{vars\ 2788}# - #{body\ 2789}#) + (#{expand-req 2584}# + #{req 2773}# + #{opt 2774}# + #{rest 2775}# + #{kw 2776}# + (cons #{e1 2768}# #{e2 2769}#))) + (lambda (#{meta 2782}# + #{req 2783}# + #{opt 2784}# + #{rest 2785}# + #{kw 2786}# + #{inits 2787}# + #{vars 2788}# + #{body 2789}#) (call-with-values (lambda () - (#{chi-lambda-case\ 480}# - #{e\ 2569}# - #{r\ 2570}# - #{w\ 2571}# - #{s\ 2572}# - #{mod\ 2573}# - #{get-formals\ 2574}# - (map (lambda (#{tmp\ 2800}# - #{tmp\ 2799}# - #{tmp\ 2798}#) - (cons #{tmp\ 2798}# - (cons #{tmp\ 2799}# - #{tmp\ 2800}#))) - #{e2*\ 2772}# - #{e1*\ 2771}# - #{args*\ 2770}#))) - (lambda (#{meta*\ 2802}# - #{else*\ 2803}#) + (#{chi-lambda-case 480}# + #{e 2569}# + #{r 2570}# + #{w 2571}# + #{s 2572}# + #{mod 2573}# + #{get-formals 2574}# + (map (lambda (#{tmp 2800}# + #{tmp 2799}# + #{tmp 2798}#) + (cons #{tmp 2798}# + (cons #{tmp 2799}# + #{tmp 2800}#))) + #{e2* 2772}# + #{e1* 2771}# + #{args* 2770}#))) + (lambda (#{meta* 2802}# #{else* 2803}#) (values (append - #{meta\ 2782}# - #{meta*\ 2802}#) - (#{build-lambda-case\ 324}# - #{s\ 2572}# - #{req\ 2783}# - #{opt\ 2784}# - #{rest\ 2785}# - #{kw\ 2786}# - #{inits\ 2787}# - #{vars\ 2788}# - #{body\ 2789}# - #{else*\ 2803}#))))))))) - #{tmp\ 2760}#) + #{meta 2782}# + #{meta* 2802}#) + (#{build-lambda-case 324}# + #{s 2572}# + #{req 2783}# + #{opt 2784}# + #{rest 2785}# + #{kw 2786}# + #{inits 2787}# + #{vars 2788}# + #{body 2789}# + #{else* 2803}#))))))))) + #{tmp 2760}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 2758}#)))))))))) - (#{strip\ 482}# - (lambda (#{x\ 2806}# #{w\ 2807}#) - (if (memq 'top (car #{w\ 2807}#)) - #{x\ 2806}# + #{tmp 2758}#)))))))))) + (#{strip 482}# + (lambda (#{x 2806}# #{w 2807}#) + (if (memq 'top (car #{w 2807}#)) + #{x 2806}# (letrec* - ((#{f\ 2814}# - (lambda (#{x\ 2815}#) - (if (#{syntax-object?\ 342}# #{x\ 2815}#) - (#{strip\ 482}# - (#{syntax-object-expression\ 344}# #{x\ 2815}#) - (#{syntax-object-wrap\ 346}# #{x\ 2815}#)) - (if (pair? #{x\ 2815}#) + ((#{f 2814}# + (lambda (#{x 2815}#) + (if (#{syntax-object? 342}# #{x 2815}#) + (#{strip 482}# + (#{syntax-object-expression 344}# #{x 2815}#) + (#{syntax-object-wrap 346}# #{x 2815}#)) + (if (pair? #{x 2815}#) (begin - (let ((#{a\ 2822}# (#{f\ 2814}# (car #{x\ 2815}#))) - (#{d\ 2823}# (#{f\ 2814}# (cdr #{x\ 2815}#)))) - (if (if (eq? #{a\ 2822}# (car #{x\ 2815}#)) - (eq? #{d\ 2823}# (cdr #{x\ 2815}#)) + (let ((#{a 2822}# (#{f 2814}# (car #{x 2815}#))) + (#{d 2823}# (#{f 2814}# (cdr #{x 2815}#)))) + (if (if (eq? #{a 2822}# (car #{x 2815}#)) + (eq? #{d 2823}# (cdr #{x 2815}#)) #f) - #{x\ 2815}# - (cons #{a\ 2822}# #{d\ 2823}#)))) - (if (vector? #{x\ 2815}#) + #{x 2815}# + (cons #{a 2822}# #{d 2823}#)))) + (if (vector? #{x 2815}#) (begin - (let ((#{old\ 2829}# (vector->list #{x\ 2815}#))) + (let ((#{old 2829}# (vector->list #{x 2815}#))) (begin - (let ((#{new\ 2831}# - (map #{f\ 2814}# #{old\ 2829}#))) - (if (#{and-map*\ 38}# + (let ((#{new 2831}# + (map #{f 2814}# #{old 2829}#))) + (if (#{and-map* 38}# eq? - #{old\ 2829}# - #{new\ 2831}#) - #{x\ 2815}# - (list->vector #{new\ 2831}#)))))) - #{x\ 2815}#)))))) - (begin (#{f\ 2814}# #{x\ 2806}#)))))) - (#{gen-var\ 484}# - (lambda (#{id\ 2833}#) + #{old 2829}# + #{new 2831}#) + #{x 2815}# + (list->vector #{new 2831}#)))))) + #{x 2815}#)))))) + (begin (#{f 2814}# #{x 2806}#)))))) + (#{gen-var 484}# + (lambda (#{id 2833}#) (begin - (let ((#{id\ 2836}# - (if (#{syntax-object?\ 342}# #{id\ 2833}#) - (#{syntax-object-expression\ 344}# #{id\ 2833}#) - #{id\ 2833}#))) + (let ((#{id 2836}# + (if (#{syntax-object? 342}# #{id 2833}#) + (#{syntax-object-expression 344}# #{id 2833}#) + #{id 2833}#))) (gensym - (string-append (symbol->string #{id\ 2836}#) " ")))))) - (#{lambda-var-list\ 486}# - (lambda (#{vars\ 2838}#) + (string-append (symbol->string #{id 2836}#) " ")))))) + (#{lambda-var-list 486}# + (lambda (#{vars 2838}#) (letrec* - ((#{lvl\ 2844}# - (lambda (#{vars\ 2845}# #{ls\ 2846}# #{w\ 2847}#) - (if (pair? #{vars\ 2845}#) - (#{lvl\ 2844}# - (cdr #{vars\ 2845}#) - (cons (#{wrap\ 442}# - (car #{vars\ 2845}#) - #{w\ 2847}# - #f) - #{ls\ 2846}#) - #{w\ 2847}#) - (if (#{id?\ 376}# #{vars\ 2845}#) - (cons (#{wrap\ 442}# #{vars\ 2845}# #{w\ 2847}# #f) - #{ls\ 2846}#) - (if (null? #{vars\ 2845}#) - #{ls\ 2846}# - (if (#{syntax-object?\ 342}# #{vars\ 2845}#) - (#{lvl\ 2844}# - (#{syntax-object-expression\ 344}# - #{vars\ 2845}#) - #{ls\ 2846}# - (#{join-wraps\ 424}# - #{w\ 2847}# - (#{syntax-object-wrap\ 346}# #{vars\ 2845}#))) - (cons #{vars\ 2845}# #{ls\ 2846}#)))))))) - (begin (#{lvl\ 2844}# #{vars\ 2838}# '() '(()))))))) + ((#{lvl 2844}# + (lambda (#{vars 2845}# #{ls 2846}# #{w 2847}#) + (if (pair? #{vars 2845}#) + (#{lvl 2844}# + (cdr #{vars 2845}#) + (cons (#{wrap 442}# (car #{vars 2845}#) #{w 2847}# #f) + #{ls 2846}#) + #{w 2847}#) + (if (#{id? 376}# #{vars 2845}#) + (cons (#{wrap 442}# #{vars 2845}# #{w 2847}# #f) + #{ls 2846}#) + (if (null? #{vars 2845}#) + #{ls 2846}# + (if (#{syntax-object? 342}# #{vars 2845}#) + (#{lvl 2844}# + (#{syntax-object-expression 344}# #{vars 2845}#) + #{ls 2846}# + (#{join-wraps 424}# + #{w 2847}# + (#{syntax-object-wrap 346}# #{vars 2845}#))) + (cons #{vars 2845}# #{ls 2846}#)))))))) + (begin (#{lvl 2844}# #{vars 2838}# '() '(()))))))) (begin - (lambda (#{src\ 804}# #{name\ 805}#) + (lambda (#{src 804}# #{name 805}#) (make-struct/no-tail (vector-ref %expanded-vtables 2) - #{src\ 804}# - #{name\ 805}#)) - (lambda (#{x\ 1182}# #{update\ 1183}#) - (vector-set! #{x\ 1182}# 1 #{update\ 1183}#)) - (lambda (#{x\ 1186}# #{update\ 1187}#) - (vector-set! #{x\ 1186}# 2 #{update\ 1187}#)) - (lambda (#{x\ 1190}# #{update\ 1191}#) - (vector-set! #{x\ 1190}# 3 #{update\ 1191}#)) - (lambda (#{x\ 1271}#) - (if (vector? #{x\ 1271}#) - (if (= (vector-length #{x\ 1271}#) 4) - (eq? (vector-ref #{x\ 1271}# 0) 'ribcage) + #{src 804}# + #{name 805}#)) + (lambda (#{x 1182}# #{update 1183}#) + (vector-set! #{x 1182}# 1 #{update 1183}#)) + (lambda (#{x 1186}# #{update 1187}#) + (vector-set! #{x 1186}# 2 #{update 1187}#)) + (lambda (#{x 1190}# #{update 1191}#) + (vector-set! #{x 1190}# 3 #{update 1191}#)) + (lambda (#{x 1271}#) + (if (vector? #{x 1271}#) + (if (= (vector-length #{x 1271}#) 4) + (eq? (vector-ref #{x 1271}# 0) 'ribcage) #f) #f)) (begin - (#{global-extend\ 372}# + (#{global-extend 372}# 'local-syntax 'letrec-syntax #t) - (#{global-extend\ 372}# + (#{global-extend 372}# 'local-syntax 'let-syntax #f) - (#{global-extend\ 372}# + (#{global-extend 372}# 'core 'fluid-let-syntax - (lambda (#{e\ 2858}# - #{r\ 2859}# - #{w\ 2860}# - #{s\ 2861}# - #{mod\ 2862}#) - (let ((#{tmp\ 2868}# #{e\ 2858}#)) - (let ((#{tmp\ 2869}# + (lambda (#{e 2858}# + #{r 2859}# + #{w 2860}# + #{s 2861}# + #{mod 2862}#) + (let ((#{tmp 2868}# #{e 2858}#)) + (let ((#{tmp 2869}# ($sc-dispatch - #{tmp\ 2868}# + #{tmp 2868}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 2869}# + (if (if #{tmp 2869}# (@apply - (lambda (#{var\ 2874}# - #{val\ 2875}# - #{e1\ 2876}# - #{e2\ 2877}#) - (#{valid-bound-ids?\ 436}# #{var\ 2874}#)) - #{tmp\ 2869}#) + (lambda (#{var 2874}# + #{val 2875}# + #{e1 2876}# + #{e2 2877}#) + (#{valid-bound-ids? 436}# #{var 2874}#)) + #{tmp 2869}#) #f) (@apply - (lambda (#{var\ 2883}# - #{val\ 2884}# - #{e1\ 2885}# - #{e2\ 2886}#) + (lambda (#{var 2883}# + #{val 2884}# + #{e1 2885}# + #{e2 2886}#) (begin - (let ((#{names\ 2888}# - (map (lambda (#{x\ 2889}#) - (#{id-var-name\ 430}# - #{x\ 2889}# - #{w\ 2860}#)) - #{var\ 2883}#))) + (let ((#{names 2888}# + (map (lambda (#{x 2889}#) + (#{id-var-name 430}# + #{x 2889}# + #{w 2860}#)) + #{var 2883}#))) (begin (for-each - (lambda (#{id\ 2892}# #{n\ 2893}#) + (lambda (#{id 2892}# #{n 2893}#) (begin - (let ((#{atom-key\ 2898}# - (car (#{lookup\ 370}# - #{n\ 2893}# - #{r\ 2859}# - #{mod\ 2862}#)))) - (if (eqv? #{atom-key\ 2898}# + (let ((#{atom-key 2898}# + (car (#{lookup 370}# + #{n 2893}# + #{r 2859}# + #{mod 2862}#)))) + (if (eqv? #{atom-key 2898}# 'displaced-lexical) (syntax-violation 'fluid-let-syntax "identifier out of context" - #{e\ 2858}# - (#{source-wrap\ 444}# - #{id\ 2892}# - #{w\ 2860}# - #{s\ 2861}# - #{mod\ 2862}#)))))) - #{var\ 2883}# - #{names\ 2888}#) - (#{chi-body\ 464}# - (cons #{e1\ 2885}# #{e2\ 2886}#) - (#{source-wrap\ 444}# - #{e\ 2858}# - #{w\ 2860}# - #{s\ 2861}# - #{mod\ 2862}#) - (#{extend-env\ 364}# - #{names\ 2888}# + #{e 2858}# + (#{source-wrap 444}# + #{id 2892}# + #{w 2860}# + #{s 2861}# + #{mod 2862}#)))))) + #{var 2883}# + #{names 2888}#) + (#{chi-body 464}# + (cons #{e1 2885}# #{e2 2886}#) + (#{source-wrap 444}# + #{e 2858}# + #{w 2860}# + #{s 2861}# + #{mod 2862}#) + (#{extend-env 364}# + #{names 2888}# (begin - (let ((#{trans-r\ 2904}# - (#{macros-only-env\ 368}# - #{r\ 2859}#))) - (map (lambda (#{x\ 2905}#) + (let ((#{trans-r 2904}# + (#{macros-only-env 368}# + #{r 2859}#))) + (map (lambda (#{x 2905}#) (cons 'macro - (#{eval-local-transformer\ 468}# - (#{chi\ 456}# - #{x\ 2905}# - #{trans-r\ 2904}# - #{w\ 2860}# - #{mod\ 2862}#) - #{mod\ 2862}#))) - #{val\ 2884}#))) - #{r\ 2859}#) - #{w\ 2860}# - #{mod\ 2862}#))))) - #{tmp\ 2869}#) - (let ((#{_\ 2910}# #{tmp\ 2868}#)) + (#{eval-local-transformer 468}# + (#{chi 456}# + #{x 2905}# + #{trans-r 2904}# + #{w 2860}# + #{mod 2862}#) + #{mod 2862}#))) + #{val 2884}#))) + #{r 2859}#) + #{w 2860}# + #{mod 2862}#))))) + #{tmp 2869}#) + (let ((#{_ 2910}# #{tmp 2868}#)) (syntax-violation 'fluid-let-syntax "bad syntax" - (#{source-wrap\ 444}# - #{e\ 2858}# - #{w\ 2860}# - #{s\ 2861}# - #{mod\ 2862}#)))))))) - (#{global-extend\ 372}# + (#{source-wrap 444}# + #{e 2858}# + #{w 2860}# + #{s 2861}# + #{mod 2862}#)))))))) + (#{global-extend 372}# 'core 'quote - (lambda (#{e\ 2911}# - #{r\ 2912}# - #{w\ 2913}# - #{s\ 2914}# - #{mod\ 2915}#) - (let ((#{tmp\ 2921}# #{e\ 2911}#)) - (let ((#{tmp\ 2922}# - ($sc-dispatch #{tmp\ 2921}# '(_ any)))) - (if #{tmp\ 2922}# + (lambda (#{e 2911}# + #{r 2912}# + #{w 2913}# + #{s 2914}# + #{mod 2915}#) + (let ((#{tmp 2921}# #{e 2911}#)) + (let ((#{tmp 2922}# + ($sc-dispatch #{tmp 2921}# '(_ any)))) + (if #{tmp 2922}# (@apply - (lambda (#{e\ 2924}#) - (#{build-data\ 328}# - #{s\ 2914}# - (#{strip\ 482}# #{e\ 2924}# #{w\ 2913}#))) - #{tmp\ 2922}#) - (let ((#{_\ 2926}# #{tmp\ 2921}#)) + (lambda (#{e 2924}#) + (#{build-data 328}# + #{s 2914}# + (#{strip 482}# #{e 2924}# #{w 2913}#))) + #{tmp 2922}#) + (let ((#{_ 2926}# #{tmp 2921}#)) (syntax-violation 'quote "bad syntax" - (#{source-wrap\ 444}# - #{e\ 2911}# - #{w\ 2913}# - #{s\ 2914}# - #{mod\ 2915}#)))))))) - (#{global-extend\ 372}# + (#{source-wrap 444}# + #{e 2911}# + #{w 2913}# + #{s 2914}# + #{mod 2915}#)))))))) + (#{global-extend 372}# 'core 'syntax (letrec* - ((#{gen-syntax\ 2928}# - (lambda (#{src\ 2943}# - #{e\ 2944}# - #{r\ 2945}# - #{maps\ 2946}# - #{ellipsis?\ 2947}# - #{mod\ 2948}#) - (if (#{id?\ 376}# #{e\ 2944}#) + ((#{gen-syntax 2928}# + (lambda (#{src 2943}# + #{e 2944}# + #{r 2945}# + #{maps 2946}# + #{ellipsis? 2947}# + #{mod 2948}#) + (if (#{id? 376}# #{e 2944}#) (begin - (let ((#{label\ 2956}# - (#{id-var-name\ 430}# #{e\ 2944}# '(())))) + (let ((#{label 2956}# + (#{id-var-name 430}# #{e 2944}# '(())))) (begin - (let ((#{b\ 2959}# - (#{lookup\ 370}# - #{label\ 2956}# - #{r\ 2945}# - #{mod\ 2948}#))) - (if (eq? (car #{b\ 2959}#) 'syntax) + (let ((#{b 2959}# + (#{lookup 370}# + #{label 2956}# + #{r 2945}# + #{mod 2948}#))) + (if (eq? (car #{b 2959}#) 'syntax) (call-with-values (lambda () (begin - (let ((#{var.lev\ 2962}# - (cdr #{b\ 2959}#))) - (#{gen-ref\ 2930}# - #{src\ 2943}# - (car #{var.lev\ 2962}#) - (cdr #{var.lev\ 2962}#) - #{maps\ 2946}#)))) - (lambda (#{var\ 2964}# #{maps\ 2965}#) + (let ((#{var.lev 2962}# (cdr #{b 2959}#))) + (#{gen-ref 2930}# + #{src 2943}# + (car #{var.lev 2962}#) + (cdr #{var.lev 2962}#) + #{maps 2946}#)))) + (lambda (#{var 2964}# #{maps 2965}#) (values - (list 'ref #{var\ 2964}#) - #{maps\ 2965}#))) - (if (#{ellipsis?\ 2947}# #{e\ 2944}#) + (list 'ref #{var 2964}#) + #{maps 2965}#))) + (if (#{ellipsis? 2947}# #{e 2944}#) (syntax-violation 'syntax "misplaced ellipsis" - #{src\ 2943}#) + #{src 2943}#) (values - (list 'quote #{e\ 2944}#) - #{maps\ 2946}#))))))) - (let ((#{tmp\ 2970}# #{e\ 2944}#)) - (let ((#{tmp\ 2971}# - ($sc-dispatch #{tmp\ 2970}# '(any any)))) - (if (if #{tmp\ 2971}# + (list 'quote #{e 2944}#) + #{maps 2946}#))))))) + (let ((#{tmp 2970}# #{e 2944}#)) + (let ((#{tmp 2971}# + ($sc-dispatch #{tmp 2970}# '(any any)))) + (if (if #{tmp 2971}# (@apply - (lambda (#{dots\ 2974}# #{e\ 2975}#) - (#{ellipsis?\ 2947}# #{dots\ 2974}#)) - #{tmp\ 2971}#) + (lambda (#{dots 2974}# #{e 2975}#) + (#{ellipsis? 2947}# #{dots 2974}#)) + #{tmp 2971}#) #f) (@apply - (lambda (#{dots\ 2978}# #{e\ 2979}#) - (#{gen-syntax\ 2928}# - #{src\ 2943}# - #{e\ 2979}# - #{r\ 2945}# - #{maps\ 2946}# - (lambda (#{x\ 2980}#) #f) - #{mod\ 2948}#)) - #{tmp\ 2971}#) - (let ((#{tmp\ 2982}# + (lambda (#{dots 2978}# #{e 2979}#) + (#{gen-syntax 2928}# + #{src 2943}# + #{e 2979}# + #{r 2945}# + #{maps 2946}# + (lambda (#{x 2980}#) #f) + #{mod 2948}#)) + #{tmp 2971}#) + (let ((#{tmp 2982}# ($sc-dispatch - #{tmp\ 2970}# + #{tmp 2970}# '(any any . any)))) - (if (if #{tmp\ 2982}# + (if (if #{tmp 2982}# (@apply - (lambda (#{x\ 2986}# - #{dots\ 2987}# - #{y\ 2988}#) - (#{ellipsis?\ 2947}# #{dots\ 2987}#)) - #{tmp\ 2982}#) + (lambda (#{x 2986}# + #{dots 2987}# + #{y 2988}#) + (#{ellipsis? 2947}# #{dots 2987}#)) + #{tmp 2982}#) #f) (@apply - (lambda (#{x\ 2992}# - #{dots\ 2993}# - #{y\ 2994}#) + (lambda (#{x 2992}# #{dots 2993}# #{y 2994}#) (letrec* - ((#{f\ 2998}# - (lambda (#{y\ 2999}# #{k\ 3000}#) - (let ((#{tmp\ 3007}# #{y\ 2999}#)) - (let ((#{tmp\ 3008}# + ((#{f 2998}# + (lambda (#{y 2999}# #{k 3000}#) + (let ((#{tmp 3007}# #{y 2999}#)) + (let ((#{tmp 3008}# ($sc-dispatch - #{tmp\ 3007}# + #{tmp 3007}# '(any . any)))) - (if (if #{tmp\ 3008}# + (if (if #{tmp 3008}# (@apply - (lambda (#{dots\ 3011}# - #{y\ 3012}#) - (#{ellipsis?\ 2947}# - #{dots\ 3011}#)) - #{tmp\ 3008}#) + (lambda (#{dots 3011}# + #{y 3012}#) + (#{ellipsis? 2947}# + #{dots 3011}#)) + #{tmp 3008}#) #f) (@apply - (lambda (#{dots\ 3015}# - #{y\ 3016}#) - (#{f\ 2998}# - #{y\ 3016}# - (lambda (#{maps\ 3017}#) + (lambda (#{dots 3015}# + #{y 3016}#) + (#{f 2998}# + #{y 3016}# + (lambda (#{maps 3017}#) (call-with-values (lambda () - (#{k\ 3000}# + (#{k 3000}# (cons '() - #{maps\ 3017}#))) - (lambda (#{x\ 3019}# - #{maps\ 3020}#) - (if (null? (car #{maps\ 3020}#)) + #{maps 3017}#))) + (lambda (#{x 3019}# + #{maps 3020}#) + (if (null? (car #{maps 3020}#)) (syntax-violation 'syntax "extra ellipsis" - #{src\ 2943}#) + #{src 2943}#) (values - (#{gen-mappend\ 2932}# - #{x\ 3019}# - (car #{maps\ 3020}#)) - (cdr #{maps\ 3020}#)))))))) - #{tmp\ 3008}#) - (let ((#{_\ 3024}# - #{tmp\ 3007}#)) + (#{gen-mappend 2932}# + #{x 3019}# + (car #{maps 3020}#)) + (cdr #{maps 3020}#)))))))) + #{tmp 3008}#) + (let ((#{_ 3024}# + #{tmp 3007}#)) (call-with-values (lambda () - (#{gen-syntax\ 2928}# - #{src\ 2943}# - #{y\ 2999}# - #{r\ 2945}# - #{maps\ 2946}# - #{ellipsis?\ 2947}# - #{mod\ 2948}#)) - (lambda (#{y\ 3025}# - #{maps\ 3026}#) + (#{gen-syntax 2928}# + #{src 2943}# + #{y 2999}# + #{r 2945}# + #{maps 2946}# + #{ellipsis? 2947}# + #{mod 2948}#)) + (lambda (#{y 3025}# + #{maps 3026}#) (call-with-values (lambda () - (#{k\ 3000}# - #{maps\ 3026}#)) - (lambda (#{x\ 3029}# - #{maps\ 3030}#) + (#{k 3000}# + #{maps 3026}#)) + (lambda (#{x 3029}# + #{maps 3030}#) (values - (#{gen-append\ 2938}# - #{x\ 3029}# - #{y\ 3025}#) - #{maps\ 3030}#)))))))))))) + (#{gen-append 2938}# + #{x 3029}# + #{y 3025}#) + #{maps 3030}#)))))))))))) (begin - (#{f\ 2998}# - #{y\ 2994}# - (lambda (#{maps\ 3001}#) + (#{f 2998}# + #{y 2994}# + (lambda (#{maps 3001}#) (call-with-values (lambda () - (#{gen-syntax\ 2928}# - #{src\ 2943}# - #{x\ 2992}# - #{r\ 2945}# - (cons '() #{maps\ 3001}#) - #{ellipsis?\ 2947}# - #{mod\ 2948}#)) - (lambda (#{x\ 3003}# - #{maps\ 3004}#) - (if (null? (car #{maps\ 3004}#)) + (#{gen-syntax 2928}# + #{src 2943}# + #{x 2992}# + #{r 2945}# + (cons '() #{maps 3001}#) + #{ellipsis? 2947}# + #{mod 2948}#)) + (lambda (#{x 3003}# #{maps 3004}#) + (if (null? (car #{maps 3004}#)) (syntax-violation 'syntax "extra ellipsis" - #{src\ 2943}#) + #{src 2943}#) (values - (#{gen-map\ 2934}# - #{x\ 3003}# - (car #{maps\ 3004}#)) - (cdr #{maps\ 3004}#)))))))))) - #{tmp\ 2982}#) - (let ((#{tmp\ 3033}# + (#{gen-map 2934}# + #{x 3003}# + (car #{maps 3004}#)) + (cdr #{maps 3004}#)))))))))) + #{tmp 2982}#) + (let ((#{tmp 3033}# ($sc-dispatch - #{tmp\ 2970}# + #{tmp 2970}# '(any . any)))) - (if #{tmp\ 3033}# + (if #{tmp 3033}# (@apply - (lambda (#{x\ 3036}# #{y\ 3037}#) + (lambda (#{x 3036}# #{y 3037}#) (call-with-values (lambda () - (#{gen-syntax\ 2928}# - #{src\ 2943}# - #{x\ 3036}# - #{r\ 2945}# - #{maps\ 2946}# - #{ellipsis?\ 2947}# - #{mod\ 2948}#)) - (lambda (#{x\ 3038}# #{maps\ 3039}#) + (#{gen-syntax 2928}# + #{src 2943}# + #{x 3036}# + #{r 2945}# + #{maps 2946}# + #{ellipsis? 2947}# + #{mod 2948}#)) + (lambda (#{x 3038}# #{maps 3039}#) (call-with-values (lambda () - (#{gen-syntax\ 2928}# - #{src\ 2943}# - #{y\ 3037}# - #{r\ 2945}# - #{maps\ 3039}# - #{ellipsis?\ 2947}# - #{mod\ 2948}#)) - (lambda (#{y\ 3042}# - #{maps\ 3043}#) + (#{gen-syntax 2928}# + #{src 2943}# + #{y 3037}# + #{r 2945}# + #{maps 3039}# + #{ellipsis? 2947}# + #{mod 2948}#)) + (lambda (#{y 3042}# #{maps 3043}#) (values - (#{gen-cons\ 2936}# - #{x\ 3038}# - #{y\ 3042}#) - #{maps\ 3043}#)))))) - #{tmp\ 3033}#) - (let ((#{tmp\ 3046}# + (#{gen-cons 2936}# + #{x 3038}# + #{y 3042}#) + #{maps 3043}#)))))) + #{tmp 3033}#) + (let ((#{tmp 3046}# ($sc-dispatch - #{tmp\ 2970}# + #{tmp 2970}# '#(vector (any . each-any))))) - (if #{tmp\ 3046}# + (if #{tmp 3046}# (@apply - (lambda (#{e1\ 3049}# #{e2\ 3050}#) + (lambda (#{e1 3049}# #{e2 3050}#) (call-with-values (lambda () - (#{gen-syntax\ 2928}# - #{src\ 2943}# - (cons #{e1\ 3049}# - #{e2\ 3050}#) - #{r\ 2945}# - #{maps\ 2946}# - #{ellipsis?\ 2947}# - #{mod\ 2948}#)) - (lambda (#{e\ 3052}# - #{maps\ 3053}#) + (#{gen-syntax 2928}# + #{src 2943}# + (cons #{e1 3049}# #{e2 3050}#) + #{r 2945}# + #{maps 2946}# + #{ellipsis? 2947}# + #{mod 2948}#)) + (lambda (#{e 3052}# #{maps 3053}#) (values - (#{gen-vector\ 2940}# - #{e\ 3052}#) - #{maps\ 3053}#)))) - #{tmp\ 3046}#) - (let ((#{_\ 3057}# #{tmp\ 2970}#)) + (#{gen-vector 2940}# + #{e 3052}#) + #{maps 3053}#)))) + #{tmp 3046}#) + (let ((#{_ 3057}# #{tmp 2970}#)) (values - (list 'quote #{e\ 2944}#) - #{maps\ 2946}#)))))))))))))) - (#{gen-ref\ 2930}# - (lambda (#{src\ 3059}# - #{var\ 3060}# - #{level\ 3061}# - #{maps\ 3062}#) - (if (= #{level\ 3061}# 0) - (values #{var\ 3060}# #{maps\ 3062}#) - (if (null? #{maps\ 3062}#) + (list 'quote #{e 2944}#) + #{maps 2946}#)))))))))))))) + (#{gen-ref 2930}# + (lambda (#{src 3059}# + #{var 3060}# + #{level 3061}# + #{maps 3062}#) + (if (= #{level 3061}# 0) + (values #{var 3060}# #{maps 3062}#) + (if (null? #{maps 3062}#) (syntax-violation 'syntax "missing ellipsis" - #{src\ 3059}#) + #{src 3059}#) (call-with-values (lambda () - (#{gen-ref\ 2930}# - #{src\ 3059}# - #{var\ 3060}# - (1- #{level\ 3061}#) - (cdr #{maps\ 3062}#))) - (lambda (#{outer-var\ 3069}# #{outer-maps\ 3070}#) + (#{gen-ref 2930}# + #{src 3059}# + #{var 3060}# + (#{1-}# #{level 3061}#) + (cdr #{maps 3062}#))) + (lambda (#{outer-var 3069}# #{outer-maps 3070}#) (begin - (let ((#{b\ 3074}# - (assq #{outer-var\ 3069}# - (car #{maps\ 3062}#)))) - (if #{b\ 3074}# - (values (cdr #{b\ 3074}#) #{maps\ 3062}#) + (let ((#{b 3074}# + (assq #{outer-var 3069}# + (car #{maps 3062}#)))) + (if #{b 3074}# + (values (cdr #{b 3074}#) #{maps 3062}#) (begin - (let ((#{inner-var\ 3076}# - (#{gen-var\ 484}# 'tmp))) + (let ((#{inner-var 3076}# + (#{gen-var 484}# 'tmp))) (values - #{inner-var\ 3076}# - (cons (cons (cons #{outer-var\ 3069}# - #{inner-var\ 3076}#) - (car #{maps\ 3062}#)) - #{outer-maps\ 3070}#))))))))))))) - (#{gen-mappend\ 2932}# - (lambda (#{e\ 3077}# #{map-env\ 3078}#) + #{inner-var 3076}# + (cons (cons (cons #{outer-var 3069}# + #{inner-var 3076}#) + (car #{maps 3062}#)) + #{outer-maps 3070}#))))))))))))) + (#{gen-mappend 2932}# + (lambda (#{e 3077}# #{map-env 3078}#) (list 'apply '(primitive append) - (#{gen-map\ 2934}# #{e\ 3077}# #{map-env\ 3078}#)))) - (#{gen-map\ 2934}# - (lambda (#{e\ 3082}# #{map-env\ 3083}#) + (#{gen-map 2934}# #{e 3077}# #{map-env 3078}#)))) + (#{gen-map 2934}# + (lambda (#{e 3082}# #{map-env 3083}#) (begin - (let ((#{formals\ 3088}# (map cdr #{map-env\ 3083}#)) - (#{actuals\ 3089}# - (map (lambda (#{x\ 3090}#) - (list 'ref (car #{x\ 3090}#))) - #{map-env\ 3083}#))) - (if (eq? (car #{e\ 3082}#) 'ref) - (car #{actuals\ 3089}#) + (let ((#{formals 3088}# (map cdr #{map-env 3083}#)) + (#{actuals 3089}# + (map (lambda (#{x 3090}#) + (list 'ref (car #{x 3090}#))) + #{map-env 3083}#))) + (if (eq? (car #{e 3082}#) 'ref) + (car #{actuals 3089}#) (if (and-map - (lambda (#{x\ 3097}#) - (if (eq? (car #{x\ 3097}#) 'ref) - (memq (car (cdr #{x\ 3097}#)) - #{formals\ 3088}#) + (lambda (#{x 3097}#) + (if (eq? (car #{x 3097}#) 'ref) + (memq (car (cdr #{x 3097}#)) + #{formals 3088}#) #f)) - (cdr #{e\ 3082}#)) + (cdr #{e 3082}#)) (cons 'map - (cons (list 'primitive (car #{e\ 3082}#)) + (cons (list 'primitive (car #{e 3082}#)) (map (begin - (let ((#{r\ 3103}# + (let ((#{r 3103}# (map cons - #{formals\ 3088}# - #{actuals\ 3089}#))) - (lambda (#{x\ 3104}#) - (cdr (assq (car (cdr #{x\ 3104}#)) - #{r\ 3103}#))))) - (cdr #{e\ 3082}#)))) + #{formals 3088}# + #{actuals 3089}#))) + (lambda (#{x 3104}#) + (cdr (assq (car (cdr #{x 3104}#)) + #{r 3103}#))))) + (cdr #{e 3082}#)))) (cons 'map (cons (list 'lambda - #{formals\ 3088}# - #{e\ 3082}#) - #{actuals\ 3089}#)))))))) - (#{gen-cons\ 2936}# - (lambda (#{x\ 3108}# #{y\ 3109}#) + #{formals 3088}# + #{e 3082}#) + #{actuals 3089}#)))))))) + (#{gen-cons 2936}# + (lambda (#{x 3108}# #{y 3109}#) (begin - (let ((#{atom-key\ 3114}# (car #{y\ 3109}#))) - (if (eqv? #{atom-key\ 3114}# 'quote) - (if (eq? (car #{x\ 3108}#) 'quote) + (let ((#{atom-key 3114}# (car #{y 3109}#))) + (if (eqv? #{atom-key 3114}# 'quote) + (if (eq? (car #{x 3108}#) 'quote) (list 'quote - (cons (car (cdr #{x\ 3108}#)) - (car (cdr #{y\ 3109}#)))) - (if (eq? (car (cdr #{y\ 3109}#)) '()) - (list 'list #{x\ 3108}#) - (list 'cons #{x\ 3108}# #{y\ 3109}#))) - (if (eqv? #{atom-key\ 3114}# 'list) - (cons 'list (cons #{x\ 3108}# (cdr #{y\ 3109}#))) - (list 'cons #{x\ 3108}# #{y\ 3109}#))))))) - (#{gen-append\ 2938}# - (lambda (#{x\ 3123}# #{y\ 3124}#) - (if (equal? #{y\ 3124}# ''()) - #{x\ 3123}# - (list 'append #{x\ 3123}# #{y\ 3124}#)))) - (#{gen-vector\ 2940}# - (lambda (#{x\ 3128}#) - (if (eq? (car #{x\ 3128}#) 'list) - (cons 'vector (cdr #{x\ 3128}#)) - (if (eq? (car #{x\ 3128}#) 'quote) + (cons (car (cdr #{x 3108}#)) + (car (cdr #{y 3109}#)))) + (if (eq? (car (cdr #{y 3109}#)) '()) + (list 'list #{x 3108}#) + (list 'cons #{x 3108}# #{y 3109}#))) + (if (eqv? #{atom-key 3114}# 'list) + (cons 'list (cons #{x 3108}# (cdr #{y 3109}#))) + (list 'cons #{x 3108}# #{y 3109}#))))))) + (#{gen-append 2938}# + (lambda (#{x 3123}# #{y 3124}#) + (if (equal? #{y 3124}# ''()) + #{x 3123}# + (list 'append #{x 3123}# #{y 3124}#)))) + (#{gen-vector 2940}# + (lambda (#{x 3128}#) + (if (eq? (car #{x 3128}#) 'list) + (cons 'vector (cdr #{x 3128}#)) + (if (eq? (car #{x 3128}#) 'quote) (list 'quote - (list->vector (car (cdr #{x\ 3128}#)))) - (list 'list->vector #{x\ 3128}#))))) - (#{regen\ 2942}# - (lambda (#{x\ 3138}#) + (list->vector (car (cdr #{x 3128}#)))) + (list 'list->vector #{x 3128}#))))) + (#{regen 2942}# + (lambda (#{x 3138}#) (begin - (let ((#{atom-key\ 3142}# (car #{x\ 3138}#))) - (if (eqv? #{atom-key\ 3142}# 'ref) - (#{build-lexical-reference\ 308}# + (let ((#{atom-key 3142}# (car #{x 3138}#))) + (if (eqv? #{atom-key 3142}# 'ref) + (#{build-lexical-reference 308}# 'value #f - (car (cdr #{x\ 3138}#)) - (car (cdr #{x\ 3138}#))) - (if (eqv? #{atom-key\ 3142}# 'primitive) - (#{build-primref\ 326}# - #f - (car (cdr #{x\ 3138}#))) - (if (eqv? #{atom-key\ 3142}# 'quote) - (#{build-data\ 328}# #f (car (cdr #{x\ 3138}#))) - (if (eqv? #{atom-key\ 3142}# 'lambda) - (if (list? (car (cdr #{x\ 3138}#))) - (#{build-simple-lambda\ 320}# + (car (cdr #{x 3138}#)) + (car (cdr #{x 3138}#))) + (if (eqv? #{atom-key 3142}# 'primitive) + (#{build-primref 326}# #f (car (cdr #{x 3138}#))) + (if (eqv? #{atom-key 3142}# 'quote) + (#{build-data 328}# #f (car (cdr #{x 3138}#))) + (if (eqv? #{atom-key 3142}# 'lambda) + (if (list? (car (cdr #{x 3138}#))) + (#{build-simple-lambda 320}# #f - (car (cdr #{x\ 3138}#)) + (car (cdr #{x 3138}#)) #f - (car (cdr #{x\ 3138}#)) + (car (cdr #{x 3138}#)) '() - (#{regen\ 2942}# - (car (cdr (cdr #{x\ 3138}#))))) - (error "how did we get here" #{x\ 3138}#)) - (#{build-application\ 302}# + (#{regen 2942}# + (car (cdr (cdr #{x 3138}#))))) + (error "how did we get here" #{x 3138}#)) + (#{build-application 302}# #f - (#{build-primref\ 326}# #f (car #{x\ 3138}#)) - (map #{regen\ 2942}# - (cdr #{x\ 3138}#)))))))))))) + (#{build-primref 326}# #f (car #{x 3138}#)) + (map #{regen 2942}# + (cdr #{x 3138}#)))))))))))) (begin - (lambda (#{e\ 3154}# - #{r\ 3155}# - #{w\ 3156}# - #{s\ 3157}# - #{mod\ 3158}#) + (lambda (#{e 3154}# + #{r 3155}# + #{w 3156}# + #{s 3157}# + #{mod 3158}#) (begin - (let ((#{e\ 3165}# - (#{source-wrap\ 444}# - #{e\ 3154}# - #{w\ 3156}# - #{s\ 3157}# - #{mod\ 3158}#))) - (let ((#{tmp\ 3166}# #{e\ 3165}#)) - (let ((#{tmp\ 3167}# - ($sc-dispatch #{tmp\ 3166}# '(_ any)))) - (if #{tmp\ 3167}# + (let ((#{e 3165}# + (#{source-wrap 444}# + #{e 3154}# + #{w 3156}# + #{s 3157}# + #{mod 3158}#))) + (let ((#{tmp 3166}# #{e 3165}#)) + (let ((#{tmp 3167}# + ($sc-dispatch #{tmp 3166}# '(_ any)))) + (if #{tmp 3167}# (@apply - (lambda (#{x\ 3169}#) + (lambda (#{x 3169}#) (call-with-values (lambda () - (#{gen-syntax\ 2928}# - #{e\ 3165}# - #{x\ 3169}# - #{r\ 3155}# + (#{gen-syntax 2928}# + #{e 3165}# + #{x 3169}# + #{r 3155}# '() - #{ellipsis?\ 472}# - #{mod\ 3158}#)) - (lambda (#{e\ 3170}# #{maps\ 3171}#) - (#{regen\ 2942}# #{e\ 3170}#)))) - #{tmp\ 3167}#) - (let ((#{_\ 3175}# #{tmp\ 3166}#)) + #{ellipsis? 472}# + #{mod 3158}#)) + (lambda (#{e 3170}# #{maps 3171}#) + (#{regen 2942}# #{e 3170}#)))) + #{tmp 3167}#) + (let ((#{_ 3175}# #{tmp 3166}#)) (syntax-violation 'syntax "bad `syntax' form" - #{e\ 3165}#))))))))))) - (#{global-extend\ 372}# + #{e 3165}#))))))))))) + (#{global-extend 372}# 'core 'lambda - (lambda (#{e\ 3176}# - #{r\ 3177}# - #{w\ 3178}# - #{s\ 3179}# - #{mod\ 3180}#) - (let ((#{tmp\ 3186}# #{e\ 3176}#)) - (let ((#{tmp\ 3187}# + (lambda (#{e 3176}# + #{r 3177}# + #{w 3178}# + #{s 3179}# + #{mod 3180}#) + (let ((#{tmp 3186}# #{e 3176}#)) + (let ((#{tmp 3187}# ($sc-dispatch - #{tmp\ 3186}# + #{tmp 3186}# '(_ any any . each-any)))) - (if #{tmp\ 3187}# + (if #{tmp 3187}# (@apply - (lambda (#{args\ 3191}# #{e1\ 3192}# #{e2\ 3193}#) + (lambda (#{args 3191}# #{e1 3192}# #{e2 3193}#) (call-with-values (lambda () - (#{lambda-formals\ 474}# #{args\ 3191}#)) - (lambda (#{req\ 3194}# - #{opt\ 3195}# - #{rest\ 3196}# - #{kw\ 3197}#) + (#{lambda-formals 474}# #{args 3191}#)) + (lambda (#{req 3194}# + #{opt 3195}# + #{rest 3196}# + #{kw 3197}#) (letrec* - ((#{lp\ 3205}# - (lambda (#{body\ 3206}# #{meta\ 3207}#) - (let ((#{tmp\ 3209}# #{body\ 3206}#)) - (let ((#{tmp\ 3210}# + ((#{lp 3205}# + (lambda (#{body 3206}# #{meta 3207}#) + (let ((#{tmp 3209}# #{body 3206}#)) + (let ((#{tmp 3210}# ($sc-dispatch - #{tmp\ 3209}# + #{tmp 3209}# '(any any . each-any)))) - (if (if #{tmp\ 3210}# + (if (if #{tmp 3210}# (@apply - (lambda (#{docstring\ 3214}# - #{e1\ 3215}# - #{e2\ 3216}#) + (lambda (#{docstring 3214}# + #{e1 3215}# + #{e2 3216}#) (string? (syntax->datum - #{docstring\ 3214}#))) - #{tmp\ 3210}#) + #{docstring 3214}#))) + #{tmp 3210}#) #f) (@apply - (lambda (#{docstring\ 3220}# - #{e1\ 3221}# - #{e2\ 3222}#) - (#{lp\ 3205}# - (cons #{e1\ 3221}# #{e2\ 3222}#) + (lambda (#{docstring 3220}# + #{e1 3221}# + #{e2 3222}#) + (#{lp 3205}# + (cons #{e1 3221}# #{e2 3222}#) (append - #{meta\ 3207}# + #{meta 3207}# (list (cons 'documentation (syntax->datum - #{docstring\ 3220}#)))))) - #{tmp\ 3210}#) - (let ((#{tmp\ 3225}# + #{docstring 3220}#)))))) + #{tmp 3210}#) + (let ((#{tmp 3225}# ($sc-dispatch - #{tmp\ 3209}# + #{tmp 3209}# '(#(vector #(each (any . any))) any . each-any)))) - (if #{tmp\ 3225}# + (if #{tmp 3225}# (@apply - (lambda (#{k\ 3230}# - #{v\ 3231}# - #{e1\ 3232}# - #{e2\ 3233}#) - (#{lp\ 3205}# - (cons #{e1\ 3232}# - #{e2\ 3233}#) + (lambda (#{k 3230}# + #{v 3231}# + #{e1 3232}# + #{e2 3233}#) + (#{lp 3205}# + (cons #{e1 3232}# + #{e2 3233}#) (append - #{meta\ 3207}# + #{meta 3207}# (syntax->datum (map cons - #{k\ 3230}# - #{v\ 3231}#))))) - #{tmp\ 3225}#) - (let ((#{_\ 3238}# #{tmp\ 3209}#)) - (#{chi-simple-lambda\ 476}# - #{e\ 3176}# - #{r\ 3177}# - #{w\ 3178}# - #{s\ 3179}# - #{mod\ 3180}# - #{req\ 3194}# - #{rest\ 3196}# - #{meta\ 3207}# - #{body\ 3206}#)))))))))) + #{k 3230}# + #{v 3231}#))))) + #{tmp 3225}#) + (let ((#{_ 3238}# #{tmp 3209}#)) + (#{chi-simple-lambda 476}# + #{e 3176}# + #{r 3177}# + #{w 3178}# + #{s 3179}# + #{mod 3180}# + #{req 3194}# + #{rest 3196}# + #{meta 3207}# + #{body 3206}#)))))))))) (begin - (#{lp\ 3205}# - (cons #{e1\ 3192}# #{e2\ 3193}#) + (#{lp 3205}# + (cons #{e1 3192}# #{e2 3193}#) '())))))) - #{tmp\ 3187}#) - (let ((#{_\ 3240}# #{tmp\ 3186}#)) + #{tmp 3187}#) + (let ((#{_ 3240}# #{tmp 3186}#)) (syntax-violation 'lambda "bad lambda" - #{e\ 3176}#))))))) - (#{global-extend\ 372}# + #{e 3176}#))))))) + (#{global-extend 372}# 'core 'lambda* - (lambda (#{e\ 3241}# - #{r\ 3242}# - #{w\ 3243}# - #{s\ 3244}# - #{mod\ 3245}#) - (let ((#{tmp\ 3251}# #{e\ 3241}#)) - (let ((#{tmp\ 3252}# + (lambda (#{e 3241}# + #{r 3242}# + #{w 3243}# + #{s 3244}# + #{mod 3245}#) + (let ((#{tmp 3251}# #{e 3241}#)) + (let ((#{tmp 3252}# ($sc-dispatch - #{tmp\ 3251}# + #{tmp 3251}# '(_ any any . each-any)))) - (if #{tmp\ 3252}# + (if #{tmp 3252}# (@apply - (lambda (#{args\ 3256}# #{e1\ 3257}# #{e2\ 3258}#) + (lambda (#{args 3256}# #{e1 3257}# #{e2 3258}#) (call-with-values (lambda () - (#{chi-lambda-case\ 480}# - #{e\ 3241}# - #{r\ 3242}# - #{w\ 3243}# - #{s\ 3244}# - #{mod\ 3245}# - #{lambda*-formals\ 478}# - (list (cons #{args\ 3256}# - (cons #{e1\ 3257}# #{e2\ 3258}#))))) - (lambda (#{meta\ 3260}# #{lcase\ 3261}#) - (#{build-case-lambda\ 322}# - #{s\ 3244}# - #{meta\ 3260}# - #{lcase\ 3261}#)))) - #{tmp\ 3252}#) - (let ((#{_\ 3265}# #{tmp\ 3251}#)) + (#{chi-lambda-case 480}# + #{e 3241}# + #{r 3242}# + #{w 3243}# + #{s 3244}# + #{mod 3245}# + #{lambda*-formals 478}# + (list (cons #{args 3256}# + (cons #{e1 3257}# #{e2 3258}#))))) + (lambda (#{meta 3260}# #{lcase 3261}#) + (#{build-case-lambda 322}# + #{s 3244}# + #{meta 3260}# + #{lcase 3261}#)))) + #{tmp 3252}#) + (let ((#{_ 3265}# #{tmp 3251}#)) (syntax-violation 'lambda "bad lambda*" - #{e\ 3241}#))))))) - (#{global-extend\ 372}# + #{e 3241}#))))))) + (#{global-extend 372}# 'core 'case-lambda - (lambda (#{e\ 3266}# - #{r\ 3267}# - #{w\ 3268}# - #{s\ 3269}# - #{mod\ 3270}#) - (let ((#{tmp\ 3276}# #{e\ 3266}#)) - (let ((#{tmp\ 3277}# + (lambda (#{e 3266}# + #{r 3267}# + #{w 3268}# + #{s 3269}# + #{mod 3270}#) + (let ((#{tmp 3276}# #{e 3266}#)) + (let ((#{tmp 3277}# ($sc-dispatch - #{tmp\ 3276}# + #{tmp 3276}# '(_ (any any . each-any) . #(each (any any . each-any)))))) - (if #{tmp\ 3277}# + (if #{tmp 3277}# (@apply - (lambda (#{args\ 3284}# - #{e1\ 3285}# - #{e2\ 3286}# - #{args*\ 3287}# - #{e1*\ 3288}# - #{e2*\ 3289}#) + (lambda (#{args 3284}# + #{e1 3285}# + #{e2 3286}# + #{args* 3287}# + #{e1* 3288}# + #{e2* 3289}#) (call-with-values (lambda () - (#{chi-lambda-case\ 480}# - #{e\ 3266}# - #{r\ 3267}# - #{w\ 3268}# - #{s\ 3269}# - #{mod\ 3270}# - #{lambda-formals\ 474}# - (cons (cons #{args\ 3284}# - (cons #{e1\ 3285}# #{e2\ 3286}#)) - (map (lambda (#{tmp\ 3293}# - #{tmp\ 3292}# - #{tmp\ 3291}#) - (cons #{tmp\ 3291}# - (cons #{tmp\ 3292}# - #{tmp\ 3293}#))) - #{e2*\ 3289}# - #{e1*\ 3288}# - #{args*\ 3287}#)))) - (lambda (#{meta\ 3295}# #{lcase\ 3296}#) - (#{build-case-lambda\ 322}# - #{s\ 3269}# - #{meta\ 3295}# - #{lcase\ 3296}#)))) - #{tmp\ 3277}#) - (let ((#{_\ 3300}# #{tmp\ 3276}#)) + (#{chi-lambda-case 480}# + #{e 3266}# + #{r 3267}# + #{w 3268}# + #{s 3269}# + #{mod 3270}# + #{lambda-formals 474}# + (cons (cons #{args 3284}# + (cons #{e1 3285}# #{e2 3286}#)) + (map (lambda (#{tmp 3293}# + #{tmp 3292}# + #{tmp 3291}#) + (cons #{tmp 3291}# + (cons #{tmp 3292}# + #{tmp 3293}#))) + #{e2* 3289}# + #{e1* 3288}# + #{args* 3287}#)))) + (lambda (#{meta 3295}# #{lcase 3296}#) + (#{build-case-lambda 322}# + #{s 3269}# + #{meta 3295}# + #{lcase 3296}#)))) + #{tmp 3277}#) + (let ((#{_ 3300}# #{tmp 3276}#)) (syntax-violation 'case-lambda "bad case-lambda" - #{e\ 3266}#))))))) - (#{global-extend\ 372}# + #{e 3266}#))))))) + (#{global-extend 372}# 'core 'case-lambda* - (lambda (#{e\ 3301}# - #{r\ 3302}# - #{w\ 3303}# - #{s\ 3304}# - #{mod\ 3305}#) - (let ((#{tmp\ 3311}# #{e\ 3301}#)) - (let ((#{tmp\ 3312}# + (lambda (#{e 3301}# + #{r 3302}# + #{w 3303}# + #{s 3304}# + #{mod 3305}#) + (let ((#{tmp 3311}# #{e 3301}#)) + (let ((#{tmp 3312}# ($sc-dispatch - #{tmp\ 3311}# + #{tmp 3311}# '(_ (any any . each-any) . #(each (any any . each-any)))))) - (if #{tmp\ 3312}# + (if #{tmp 3312}# (@apply - (lambda (#{args\ 3319}# - #{e1\ 3320}# - #{e2\ 3321}# - #{args*\ 3322}# - #{e1*\ 3323}# - #{e2*\ 3324}#) + (lambda (#{args 3319}# + #{e1 3320}# + #{e2 3321}# + #{args* 3322}# + #{e1* 3323}# + #{e2* 3324}#) (call-with-values (lambda () - (#{chi-lambda-case\ 480}# - #{e\ 3301}# - #{r\ 3302}# - #{w\ 3303}# - #{s\ 3304}# - #{mod\ 3305}# - #{lambda*-formals\ 478}# - (cons (cons #{args\ 3319}# - (cons #{e1\ 3320}# #{e2\ 3321}#)) - (map (lambda (#{tmp\ 3328}# - #{tmp\ 3327}# - #{tmp\ 3326}#) - (cons #{tmp\ 3326}# - (cons #{tmp\ 3327}# - #{tmp\ 3328}#))) - #{e2*\ 3324}# - #{e1*\ 3323}# - #{args*\ 3322}#)))) - (lambda (#{meta\ 3330}# #{lcase\ 3331}#) - (#{build-case-lambda\ 322}# - #{s\ 3304}# - #{meta\ 3330}# - #{lcase\ 3331}#)))) - #{tmp\ 3312}#) - (let ((#{_\ 3335}# #{tmp\ 3311}#)) + (#{chi-lambda-case 480}# + #{e 3301}# + #{r 3302}# + #{w 3303}# + #{s 3304}# + #{mod 3305}# + #{lambda*-formals 478}# + (cons (cons #{args 3319}# + (cons #{e1 3320}# #{e2 3321}#)) + (map (lambda (#{tmp 3328}# + #{tmp 3327}# + #{tmp 3326}#) + (cons #{tmp 3326}# + (cons #{tmp 3327}# + #{tmp 3328}#))) + #{e2* 3324}# + #{e1* 3323}# + #{args* 3322}#)))) + (lambda (#{meta 3330}# #{lcase 3331}#) + (#{build-case-lambda 322}# + #{s 3304}# + #{meta 3330}# + #{lcase 3331}#)))) + #{tmp 3312}#) + (let ((#{_ 3335}# #{tmp 3311}#)) (syntax-violation 'case-lambda "bad case-lambda*" - #{e\ 3301}#))))))) - (#{global-extend\ 372}# + #{e 3301}#))))))) + (#{global-extend 372}# 'core 'let (letrec* - ((#{chi-let\ 3337}# - (lambda (#{e\ 3338}# - #{r\ 3339}# - #{w\ 3340}# - #{s\ 3341}# - #{mod\ 3342}# - #{constructor\ 3343}# - #{ids\ 3344}# - #{vals\ 3345}# - #{exps\ 3346}#) - (if (not (#{valid-bound-ids?\ 436}# #{ids\ 3344}#)) + ((#{chi-let 3337}# + (lambda (#{e 3338}# + #{r 3339}# + #{w 3340}# + #{s 3341}# + #{mod 3342}# + #{constructor 3343}# + #{ids 3344}# + #{vals 3345}# + #{exps 3346}#) + (if (not (#{valid-bound-ids? 436}# #{ids 3344}#)) (syntax-violation 'let "duplicate bound variable" - #{e\ 3338}#) + #{e 3338}#) (begin - (let ((#{labels\ 3358}# - (#{gen-labels\ 391}# #{ids\ 3344}#)) - (#{new-vars\ 3359}# - (map #{gen-var\ 484}# #{ids\ 3344}#))) + (let ((#{labels 3358}# + (#{gen-labels 391}# #{ids 3344}#)) + (#{new-vars 3359}# + (map #{gen-var 484}# #{ids 3344}#))) (begin - (let ((#{nw\ 3362}# - (#{make-binding-wrap\ 420}# - #{ids\ 3344}# - #{labels\ 3358}# - #{w\ 3340}#)) - (#{nr\ 3363}# - (#{extend-var-env\ 366}# - #{labels\ 3358}# - #{new-vars\ 3359}# - #{r\ 3339}#))) - (#{constructor\ 3343}# - #{s\ 3341}# - (map syntax->datum #{ids\ 3344}#) - #{new-vars\ 3359}# - (map (lambda (#{x\ 3364}#) - (#{chi\ 456}# - #{x\ 3364}# - #{r\ 3339}# - #{w\ 3340}# - #{mod\ 3342}#)) - #{vals\ 3345}#) - (#{chi-body\ 464}# - #{exps\ 3346}# - (#{source-wrap\ 444}# - #{e\ 3338}# - #{nw\ 3362}# - #{s\ 3341}# - #{mod\ 3342}#) - #{nr\ 3363}# - #{nw\ 3362}# - #{mod\ 3342}#)))))))))) + (let ((#{nw 3362}# + (#{make-binding-wrap 420}# + #{ids 3344}# + #{labels 3358}# + #{w 3340}#)) + (#{nr 3363}# + (#{extend-var-env 366}# + #{labels 3358}# + #{new-vars 3359}# + #{r 3339}#))) + (#{constructor 3343}# + #{s 3341}# + (map syntax->datum #{ids 3344}#) + #{new-vars 3359}# + (map (lambda (#{x 3364}#) + (#{chi 456}# + #{x 3364}# + #{r 3339}# + #{w 3340}# + #{mod 3342}#)) + #{vals 3345}#) + (#{chi-body 464}# + #{exps 3346}# + (#{source-wrap 444}# + #{e 3338}# + #{nw 3362}# + #{s 3341}# + #{mod 3342}#) + #{nr 3363}# + #{nw 3362}# + #{mod 3342}#)))))))))) (begin - (lambda (#{e\ 3366}# - #{r\ 3367}# - #{w\ 3368}# - #{s\ 3369}# - #{mod\ 3370}#) - (let ((#{tmp\ 3376}# #{e\ 3366}#)) - (let ((#{tmp\ 3377}# + (lambda (#{e 3366}# + #{r 3367}# + #{w 3368}# + #{s 3369}# + #{mod 3370}#) + (let ((#{tmp 3376}# #{e 3366}#)) + (let ((#{tmp 3377}# ($sc-dispatch - #{tmp\ 3376}# + #{tmp 3376}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3377}# + (if (if #{tmp 3377}# (@apply - (lambda (#{id\ 3382}# - #{val\ 3383}# - #{e1\ 3384}# - #{e2\ 3385}#) - (and-map #{id?\ 376}# #{id\ 3382}#)) - #{tmp\ 3377}#) + (lambda (#{id 3382}# + #{val 3383}# + #{e1 3384}# + #{e2 3385}#) + (and-map #{id? 376}# #{id 3382}#)) + #{tmp 3377}#) #f) (@apply - (lambda (#{id\ 3391}# - #{val\ 3392}# - #{e1\ 3393}# - #{e2\ 3394}#) - (#{chi-let\ 3337}# - #{e\ 3366}# - #{r\ 3367}# - #{w\ 3368}# - #{s\ 3369}# - #{mod\ 3370}# - #{build-let\ 332}# - #{id\ 3391}# - #{val\ 3392}# - (cons #{e1\ 3393}# #{e2\ 3394}#))) - #{tmp\ 3377}#) - (let ((#{tmp\ 3398}# + (lambda (#{id 3391}# + #{val 3392}# + #{e1 3393}# + #{e2 3394}#) + (#{chi-let 3337}# + #{e 3366}# + #{r 3367}# + #{w 3368}# + #{s 3369}# + #{mod 3370}# + #{build-let 332}# + #{id 3391}# + #{val 3392}# + (cons #{e1 3393}# #{e2 3394}#))) + #{tmp 3377}#) + (let ((#{tmp 3398}# ($sc-dispatch - #{tmp\ 3376}# + #{tmp 3376}# '(_ any #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3398}# + (if (if #{tmp 3398}# (@apply - (lambda (#{f\ 3404}# - #{id\ 3405}# - #{val\ 3406}# - #{e1\ 3407}# - #{e2\ 3408}#) - (if (#{id?\ 376}# #{f\ 3404}#) - (and-map #{id?\ 376}# #{id\ 3405}#) + (lambda (#{f 3404}# + #{id 3405}# + #{val 3406}# + #{e1 3407}# + #{e2 3408}#) + (if (#{id? 376}# #{f 3404}#) + (and-map #{id? 376}# #{id 3405}#) #f)) - #{tmp\ 3398}#) + #{tmp 3398}#) #f) (@apply - (lambda (#{f\ 3417}# - #{id\ 3418}# - #{val\ 3419}# - #{e1\ 3420}# - #{e2\ 3421}#) - (#{chi-let\ 3337}# - #{e\ 3366}# - #{r\ 3367}# - #{w\ 3368}# - #{s\ 3369}# - #{mod\ 3370}# - #{build-named-let\ 334}# - (cons #{f\ 3417}# #{id\ 3418}#) - #{val\ 3419}# - (cons #{e1\ 3420}# #{e2\ 3421}#))) - #{tmp\ 3398}#) - (let ((#{_\ 3426}# #{tmp\ 3376}#)) + (lambda (#{f 3417}# + #{id 3418}# + #{val 3419}# + #{e1 3420}# + #{e2 3421}#) + (#{chi-let 3337}# + #{e 3366}# + #{r 3367}# + #{w 3368}# + #{s 3369}# + #{mod 3370}# + #{build-named-let 334}# + (cons #{f 3417}# #{id 3418}#) + #{val 3419}# + (cons #{e1 3420}# #{e2 3421}#))) + #{tmp 3398}#) + (let ((#{_ 3426}# #{tmp 3376}#)) (syntax-violation 'let "bad let" - (#{source-wrap\ 444}# - #{e\ 3366}# - #{w\ 3368}# - #{s\ 3369}# - #{mod\ 3370}#)))))))))))) - (#{global-extend\ 372}# + (#{source-wrap 444}# + #{e 3366}# + #{w 3368}# + #{s 3369}# + #{mod 3370}#)))))))))))) + (#{global-extend 372}# 'core 'letrec - (lambda (#{e\ 3427}# - #{r\ 3428}# - #{w\ 3429}# - #{s\ 3430}# - #{mod\ 3431}#) - (let ((#{tmp\ 3437}# #{e\ 3427}#)) - (let ((#{tmp\ 3438}# + (lambda (#{e 3427}# + #{r 3428}# + #{w 3429}# + #{s 3430}# + #{mod 3431}#) + (let ((#{tmp 3437}# #{e 3427}#)) + (let ((#{tmp 3438}# ($sc-dispatch - #{tmp\ 3437}# + #{tmp 3437}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3438}# + (if (if #{tmp 3438}# (@apply - (lambda (#{id\ 3443}# - #{val\ 3444}# - #{e1\ 3445}# - #{e2\ 3446}#) - (and-map #{id?\ 376}# #{id\ 3443}#)) - #{tmp\ 3438}#) + (lambda (#{id 3443}# + #{val 3444}# + #{e1 3445}# + #{e2 3446}#) + (and-map #{id? 376}# #{id 3443}#)) + #{tmp 3438}#) #f) (@apply - (lambda (#{id\ 3452}# - #{val\ 3453}# - #{e1\ 3454}# - #{e2\ 3455}#) + (lambda (#{id 3452}# + #{val 3453}# + #{e1 3454}# + #{e2 3455}#) (begin - (let ((#{ids\ 3457}# #{id\ 3452}#)) - (if (not (#{valid-bound-ids?\ 436}# #{ids\ 3457}#)) + (let ((#{ids 3457}# #{id 3452}#)) + (if (not (#{valid-bound-ids? 436}# #{ids 3457}#)) (syntax-violation 'letrec "duplicate bound variable" - #{e\ 3427}#) + #{e 3427}#) (begin - (let ((#{labels\ 3461}# - (#{gen-labels\ 391}# #{ids\ 3457}#)) - (#{new-vars\ 3462}# - (map #{gen-var\ 484}# #{ids\ 3457}#))) + (let ((#{labels 3461}# + (#{gen-labels 391}# #{ids 3457}#)) + (#{new-vars 3462}# + (map #{gen-var 484}# #{ids 3457}#))) (begin - (let ((#{w\ 3465}# - (#{make-binding-wrap\ 420}# - #{ids\ 3457}# - #{labels\ 3461}# - #{w\ 3429}#)) - (#{r\ 3466}# - (#{extend-var-env\ 366}# - #{labels\ 3461}# - #{new-vars\ 3462}# - #{r\ 3428}#))) - (#{build-letrec\ 336}# - #{s\ 3430}# + (let ((#{w 3465}# + (#{make-binding-wrap 420}# + #{ids 3457}# + #{labels 3461}# + #{w 3429}#)) + (#{r 3466}# + (#{extend-var-env 366}# + #{labels 3461}# + #{new-vars 3462}# + #{r 3428}#))) + (#{build-letrec 336}# + #{s 3430}# #f - (map syntax->datum #{ids\ 3457}#) - #{new-vars\ 3462}# - (map (lambda (#{x\ 3467}#) - (#{chi\ 456}# - #{x\ 3467}# - #{r\ 3466}# - #{w\ 3465}# - #{mod\ 3431}#)) - #{val\ 3453}#) - (#{chi-body\ 464}# - (cons #{e1\ 3454}# #{e2\ 3455}#) - (#{source-wrap\ 444}# - #{e\ 3427}# - #{w\ 3465}# - #{s\ 3430}# - #{mod\ 3431}#) - #{r\ 3466}# - #{w\ 3465}# - #{mod\ 3431}#)))))))))) - #{tmp\ 3438}#) - (let ((#{_\ 3472}# #{tmp\ 3437}#)) + (map syntax->datum #{ids 3457}#) + #{new-vars 3462}# + (map (lambda (#{x 3467}#) + (#{chi 456}# + #{x 3467}# + #{r 3466}# + #{w 3465}# + #{mod 3431}#)) + #{val 3453}#) + (#{chi-body 464}# + (cons #{e1 3454}# #{e2 3455}#) + (#{source-wrap 444}# + #{e 3427}# + #{w 3465}# + #{s 3430}# + #{mod 3431}#) + #{r 3466}# + #{w 3465}# + #{mod 3431}#)))))))))) + #{tmp 3438}#) + (let ((#{_ 3472}# #{tmp 3437}#)) (syntax-violation 'letrec "bad letrec" - (#{source-wrap\ 444}# - #{e\ 3427}# - #{w\ 3429}# - #{s\ 3430}# - #{mod\ 3431}#)))))))) - (#{global-extend\ 372}# + (#{source-wrap 444}# + #{e 3427}# + #{w 3429}# + #{s 3430}# + #{mod 3431}#)))))))) + (#{global-extend 372}# 'core 'letrec* - (lambda (#{e\ 3473}# - #{r\ 3474}# - #{w\ 3475}# - #{s\ 3476}# - #{mod\ 3477}#) - (let ((#{tmp\ 3483}# #{e\ 3473}#)) - (let ((#{tmp\ 3484}# + (lambda (#{e 3473}# + #{r 3474}# + #{w 3475}# + #{s 3476}# + #{mod 3477}#) + (let ((#{tmp 3483}# #{e 3473}#)) + (let ((#{tmp 3484}# ($sc-dispatch - #{tmp\ 3483}# + #{tmp 3483}# '(_ #(each (any any)) any . each-any)))) - (if (if #{tmp\ 3484}# + (if (if #{tmp 3484}# (@apply - (lambda (#{id\ 3489}# - #{val\ 3490}# - #{e1\ 3491}# - #{e2\ 3492}#) - (and-map #{id?\ 376}# #{id\ 3489}#)) - #{tmp\ 3484}#) + (lambda (#{id 3489}# + #{val 3490}# + #{e1 3491}# + #{e2 3492}#) + (and-map #{id? 376}# #{id 3489}#)) + #{tmp 3484}#) #f) (@apply - (lambda (#{id\ 3498}# - #{val\ 3499}# - #{e1\ 3500}# - #{e2\ 3501}#) + (lambda (#{id 3498}# + #{val 3499}# + #{e1 3500}# + #{e2 3501}#) (begin - (let ((#{ids\ 3503}# #{id\ 3498}#)) - (if (not (#{valid-bound-ids?\ 436}# #{ids\ 3503}#)) + (let ((#{ids 3503}# #{id 3498}#)) + (if (not (#{valid-bound-ids? 436}# #{ids 3503}#)) (syntax-violation 'letrec* "duplicate bound variable" - #{e\ 3473}#) + #{e 3473}#) (begin - (let ((#{labels\ 3507}# - (#{gen-labels\ 391}# #{ids\ 3503}#)) - (#{new-vars\ 3508}# - (map #{gen-var\ 484}# #{ids\ 3503}#))) + (let ((#{labels 3507}# + (#{gen-labels 391}# #{ids 3503}#)) + (#{new-vars 3508}# + (map #{gen-var 484}# #{ids 3503}#))) (begin - (let ((#{w\ 3511}# - (#{make-binding-wrap\ 420}# - #{ids\ 3503}# - #{labels\ 3507}# - #{w\ 3475}#)) - (#{r\ 3512}# - (#{extend-var-env\ 366}# - #{labels\ 3507}# - #{new-vars\ 3508}# - #{r\ 3474}#))) - (#{build-letrec\ 336}# - #{s\ 3476}# + (let ((#{w 3511}# + (#{make-binding-wrap 420}# + #{ids 3503}# + #{labels 3507}# + #{w 3475}#)) + (#{r 3512}# + (#{extend-var-env 366}# + #{labels 3507}# + #{new-vars 3508}# + #{r 3474}#))) + (#{build-letrec 336}# + #{s 3476}# #t - (map syntax->datum #{ids\ 3503}#) - #{new-vars\ 3508}# - (map (lambda (#{x\ 3513}#) - (#{chi\ 456}# - #{x\ 3513}# - #{r\ 3512}# - #{w\ 3511}# - #{mod\ 3477}#)) - #{val\ 3499}#) - (#{chi-body\ 464}# - (cons #{e1\ 3500}# #{e2\ 3501}#) - (#{source-wrap\ 444}# - #{e\ 3473}# - #{w\ 3511}# - #{s\ 3476}# - #{mod\ 3477}#) - #{r\ 3512}# - #{w\ 3511}# - #{mod\ 3477}#)))))))))) - #{tmp\ 3484}#) - (let ((#{_\ 3518}# #{tmp\ 3483}#)) + (map syntax->datum #{ids 3503}#) + #{new-vars 3508}# + (map (lambda (#{x 3513}#) + (#{chi 456}# + #{x 3513}# + #{r 3512}# + #{w 3511}# + #{mod 3477}#)) + #{val 3499}#) + (#{chi-body 464}# + (cons #{e1 3500}# #{e2 3501}#) + (#{source-wrap 444}# + #{e 3473}# + #{w 3511}# + #{s 3476}# + #{mod 3477}#) + #{r 3512}# + #{w 3511}# + #{mod 3477}#)))))))))) + #{tmp 3484}#) + (let ((#{_ 3518}# #{tmp 3483}#)) (syntax-violation 'letrec* "bad letrec*" - (#{source-wrap\ 444}# - #{e\ 3473}# - #{w\ 3475}# - #{s\ 3476}# - #{mod\ 3477}#)))))))) - (#{global-extend\ 372}# + (#{source-wrap 444}# + #{e 3473}# + #{w 3475}# + #{s 3476}# + #{mod 3477}#)))))))) + (#{global-extend 372}# 'core 'set! - (lambda (#{e\ 3519}# - #{r\ 3520}# - #{w\ 3521}# - #{s\ 3522}# - #{mod\ 3523}#) - (let ((#{tmp\ 3529}# #{e\ 3519}#)) - (let ((#{tmp\ 3530}# - ($sc-dispatch #{tmp\ 3529}# '(_ any any)))) - (if (if #{tmp\ 3530}# + (lambda (#{e 3519}# + #{r 3520}# + #{w 3521}# + #{s 3522}# + #{mod 3523}#) + (let ((#{tmp 3529}# #{e 3519}#)) + (let ((#{tmp 3530}# + ($sc-dispatch #{tmp 3529}# '(_ any any)))) + (if (if #{tmp 3530}# (@apply - (lambda (#{id\ 3533}# #{val\ 3534}#) - (#{id?\ 376}# #{id\ 3533}#)) - #{tmp\ 3530}#) + (lambda (#{id 3533}# #{val 3534}#) + (#{id? 376}# #{id 3533}#)) + #{tmp 3530}#) #f) (@apply - (lambda (#{id\ 3537}# #{val\ 3538}#) + (lambda (#{id 3537}# #{val 3538}#) (begin - (let ((#{n\ 3541}# - (#{id-var-name\ 430}# - #{id\ 3537}# - #{w\ 3521}#)) - (#{id-mod\ 3542}# - (if (#{syntax-object?\ 342}# #{id\ 3537}#) - (#{syntax-object-module\ 348}# - #{id\ 3537}#) - #{mod\ 3523}#))) + (let ((#{n 3541}# + (#{id-var-name 430}# #{id 3537}# #{w 3521}#)) + (#{id-mod 3542}# + (if (#{syntax-object? 342}# #{id 3537}#) + (#{syntax-object-module 348}# #{id 3537}#) + #{mod 3523}#))) (begin - (let ((#{b\ 3544}# - (#{lookup\ 370}# - #{n\ 3541}# - #{r\ 3520}# - #{id-mod\ 3542}#))) + (let ((#{b 3544}# + (#{lookup 370}# + #{n 3541}# + #{r 3520}# + #{id-mod 3542}#))) (begin - (let ((#{atom-key\ 3547}# (car #{b\ 3544}#))) - (if (eqv? #{atom-key\ 3547}# 'lexical) - (#{build-lexical-assignment\ 310}# - #{s\ 3522}# - (syntax->datum #{id\ 3537}#) - (cdr #{b\ 3544}#) - (#{chi\ 456}# - #{val\ 3538}# - #{r\ 3520}# - #{w\ 3521}# - #{mod\ 3523}#)) - (if (eqv? #{atom-key\ 3547}# 'global) - (#{build-global-assignment\ 316}# - #{s\ 3522}# - #{n\ 3541}# - (#{chi\ 456}# - #{val\ 3538}# - #{r\ 3520}# - #{w\ 3521}# - #{mod\ 3523}#) - #{id-mod\ 3542}#) - (if (eqv? #{atom-key\ 3547}# 'macro) + (let ((#{atom-key 3547}# (car #{b 3544}#))) + (if (eqv? #{atom-key 3547}# 'lexical) + (#{build-lexical-assignment 310}# + #{s 3522}# + (syntax->datum #{id 3537}#) + (cdr #{b 3544}#) + (#{chi 456}# + #{val 3538}# + #{r 3520}# + #{w 3521}# + #{mod 3523}#)) + (if (eqv? #{atom-key 3547}# 'global) + (#{build-global-assignment 316}# + #{s 3522}# + #{n 3541}# + (#{chi 456}# + #{val 3538}# + #{r 3520}# + #{w 3521}# + #{mod 3523}#) + #{id-mod 3542}#) + (if (eqv? #{atom-key 3547}# 'macro) (begin - (let ((#{p\ 3554}# - (cdr #{b\ 3544}#))) + (let ((#{p 3554}# + (cdr #{b 3544}#))) (if (procedure-property - #{p\ 3554}# + #{p 3554}# 'variable-transformer) - (#{chi\ 456}# - (#{chi-macro\ 462}# - #{p\ 3554}# - #{e\ 3519}# - #{r\ 3520}# - #{w\ 3521}# - #{s\ 3522}# + (#{chi 456}# + (#{chi-macro 462}# + #{p 3554}# + #{e 3519}# + #{r 3520}# + #{w 3521}# + #{s 3522}# #f - #{mod\ 3523}#) - #{r\ 3520}# + #{mod 3523}#) + #{r 3520}# '(()) - #{mod\ 3523}#) + #{mod 3523}#) (syntax-violation 'set! "not a variable transformer" - (#{wrap\ 442}# - #{e\ 3519}# - #{w\ 3521}# - #{mod\ 3523}#) - (#{wrap\ 442}# - #{id\ 3537}# - #{w\ 3521}# - #{id-mod\ 3542}#))))) - (if (eqv? #{atom-key\ 3547}# + (#{wrap 442}# + #{e 3519}# + #{w 3521}# + #{mod 3523}#) + (#{wrap 442}# + #{id 3537}# + #{w 3521}# + #{id-mod 3542}#))))) + (if (eqv? #{atom-key 3547}# 'displaced-lexical) (syntax-violation 'set! "identifier out of context" - (#{wrap\ 442}# - #{id\ 3537}# - #{w\ 3521}# - #{mod\ 3523}#)) + (#{wrap 442}# + #{id 3537}# + #{w 3521}# + #{mod 3523}#)) (syntax-violation 'set! "bad set!" - (#{source-wrap\ 444}# - #{e\ 3519}# - #{w\ 3521}# - #{s\ 3522}# - #{mod\ 3523}#))))))))))))) - #{tmp\ 3530}#) - (let ((#{tmp\ 3559}# + (#{source-wrap 444}# + #{e 3519}# + #{w 3521}# + #{s 3522}# + #{mod 3523}#))))))))))))) + #{tmp 3530}#) + (let ((#{tmp 3559}# ($sc-dispatch - #{tmp\ 3529}# + #{tmp 3529}# '(_ (any . each-any) any)))) - (if #{tmp\ 3559}# + (if #{tmp 3559}# (@apply - (lambda (#{head\ 3563}# #{tail\ 3564}# #{val\ 3565}#) + (lambda (#{head 3563}# #{tail 3564}# #{val 3565}#) (call-with-values (lambda () - (#{syntax-type\ 454}# - #{head\ 3563}# - #{r\ 3520}# + (#{syntax-type 454}# + #{head 3563}# + #{r 3520}# '(()) #f #f - #{mod\ 3523}# + #{mod 3523}# #t)) - (lambda (#{type\ 3568}# - #{value\ 3569}# - #{ee\ 3570}# - #{ww\ 3571}# - #{ss\ 3572}# - #{modmod\ 3573}#) - (if (eqv? #{type\ 3568}# 'module-ref) + (lambda (#{type 3568}# + #{value 3569}# + #{ee 3570}# + #{ww 3571}# + #{ss 3572}# + #{modmod 3573}#) + (if (eqv? #{type 3568}# 'module-ref) (begin - (let ((#{val\ 3582}# - (#{chi\ 456}# - #{val\ 3565}# - #{r\ 3520}# - #{w\ 3521}# - #{mod\ 3523}#))) + (let ((#{val 3582}# + (#{chi 456}# + #{val 3565}# + #{r 3520}# + #{w 3521}# + #{mod 3523}#))) (call-with-values (lambda () - (#{value\ 3569}# - (cons #{head\ 3563}# - #{tail\ 3564}#) - #{r\ 3520}# - #{w\ 3521}#)) - (lambda (#{e\ 3584}# - #{r\ 3585}# - #{w\ 3586}# - #{s*\ 3587}# - #{mod\ 3588}#) - (let ((#{tmp\ 3594}# #{e\ 3584}#)) - (let ((#{tmp\ 3595}# - (list #{tmp\ 3594}#))) - (if (if #{tmp\ 3595}# + (#{value 3569}# + (cons #{head 3563}# #{tail 3564}#) + #{r 3520}# + #{w 3521}#)) + (lambda (#{e 3584}# + #{r 3585}# + #{w 3586}# + #{s* 3587}# + #{mod 3588}#) + (let ((#{tmp 3594}# #{e 3584}#)) + (let ((#{tmp 3595}# + (list #{tmp 3594}#))) + (if (if #{tmp 3595}# (@apply - (lambda (#{e\ 3597}#) - (#{id?\ 376}# - #{e\ 3597}#)) - #{tmp\ 3595}#) + (lambda (#{e 3597}#) + (#{id? 376}# + #{e 3597}#)) + #{tmp 3595}#) #f) (@apply - (lambda (#{e\ 3599}#) - (#{build-global-assignment\ 316}# - #{s\ 3522}# + (lambda (#{e 3599}#) + (#{build-global-assignment 316}# + #{s 3522}# (syntax->datum - #{e\ 3599}#) - #{val\ 3582}# - #{mod\ 3588}#)) - #{tmp\ 3595}#) + #{e 3599}#) + #{val 3582}# + #{mod 3588}#)) + #{tmp 3595}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3594}#)))))))) - (#{build-application\ 302}# - #{s\ 3522}# - (#{chi\ 456}# + #{tmp 3594}#)))))))) + (#{build-application 302}# + #{s 3522}# + (#{chi 456}# (list '#(syntax-object setter ((top) @@ -10598,50 +10541,50 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile)) - #{head\ 3563}#) - #{r\ 3520}# - #{w\ 3521}# - #{mod\ 3523}#) - (map (lambda (#{e\ 3601}#) - (#{chi\ 456}# - #{e\ 3601}# - #{r\ 3520}# - #{w\ 3521}# - #{mod\ 3523}#)) + #{head 3563}#) + #{r 3520}# + #{w 3521}# + #{mod 3523}#) + (map (lambda (#{e 3601}#) + (#{chi 456}# + #{e 3601}# + #{r 3520}# + #{w 3521}# + #{mod 3523}#)) (append - #{tail\ 3564}# - (list #{val\ 3565}#)))))))) - #{tmp\ 3559}#) - (let ((#{_\ 3605}# #{tmp\ 3529}#)) + #{tail 3564}# + (list #{val 3565}#)))))))) + #{tmp 3559}#) + (let ((#{_ 3605}# #{tmp 3529}#)) (syntax-violation 'set! "bad set!" - (#{source-wrap\ 444}# - #{e\ 3519}# - #{w\ 3521}# - #{s\ 3522}# - #{mod\ 3523}#)))))))))) - (#{global-extend\ 372}# + (#{source-wrap 444}# + #{e 3519}# + #{w 3521}# + #{s 3522}# + #{mod 3523}#)))))))))) + (#{global-extend 372}# 'module-ref '@ - (lambda (#{e\ 3606}# #{r\ 3607}# #{w\ 3608}#) - (let ((#{tmp\ 3612}# #{e\ 3606}#)) - (let ((#{tmp\ 3613}# - ($sc-dispatch #{tmp\ 3612}# '(_ each-any any)))) - (if (if #{tmp\ 3613}# + (lambda (#{e 3606}# #{r 3607}# #{w 3608}#) + (let ((#{tmp 3612}# #{e 3606}#)) + (let ((#{tmp 3613}# + ($sc-dispatch #{tmp 3612}# '(_ each-any any)))) + (if (if #{tmp 3613}# (@apply - (lambda (#{mod\ 3616}# #{id\ 3617}#) - (if (and-map #{id?\ 376}# #{mod\ 3616}#) - (#{id?\ 376}# #{id\ 3617}#) + (lambda (#{mod 3616}# #{id 3617}#) + (if (and-map #{id? 376}# #{mod 3616}#) + (#{id? 376}# #{id 3617}#) #f)) - #{tmp\ 3613}#) + #{tmp 3613}#) #f) (@apply - (lambda (#{mod\ 3623}# #{id\ 3624}#) + (lambda (#{mod 3623}# #{id 3624}#) (values - (syntax->datum #{id\ 3624}#) - #{r\ 3607}# - #{w\ 3608}# + (syntax->datum #{id 3624}#) + #{r 3607}# + #{w 3608}# #f (syntax->datum (cons '#(syntax-object @@ -11073,70 +11016,70 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile)) - #{mod\ 3623}#)))) - #{tmp\ 3613}#) + #{mod 3623}#)))) + #{tmp 3613}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3612}#)))))) - (#{global-extend\ 372}# + #{tmp 3612}#)))))) + (#{global-extend 372}# 'module-ref '@@ - (lambda (#{e\ 3626}# #{r\ 3627}# #{w\ 3628}#) + (lambda (#{e 3626}# #{r 3627}# #{w 3628}#) (letrec* - ((#{remodulate\ 3633}# - (lambda (#{x\ 3634}# #{mod\ 3635}#) - (if (pair? #{x\ 3634}#) - (cons (#{remodulate\ 3633}# - (car #{x\ 3634}#) - #{mod\ 3635}#) - (#{remodulate\ 3633}# - (cdr #{x\ 3634}#) - #{mod\ 3635}#)) - (if (#{syntax-object?\ 342}# #{x\ 3634}#) - (#{make-syntax-object\ 340}# - (#{remodulate\ 3633}# - (#{syntax-object-expression\ 344}# #{x\ 3634}#) - #{mod\ 3635}#) - (#{syntax-object-wrap\ 346}# #{x\ 3634}#) - #{mod\ 3635}#) - (if (vector? #{x\ 3634}#) + ((#{remodulate 3633}# + (lambda (#{x 3634}# #{mod 3635}#) + (if (pair? #{x 3634}#) + (cons (#{remodulate 3633}# + (car #{x 3634}#) + #{mod 3635}#) + (#{remodulate 3633}# + (cdr #{x 3634}#) + #{mod 3635}#)) + (if (#{syntax-object? 342}# #{x 3634}#) + (#{make-syntax-object 340}# + (#{remodulate 3633}# + (#{syntax-object-expression 344}# #{x 3634}#) + #{mod 3635}#) + (#{syntax-object-wrap 346}# #{x 3634}#) + #{mod 3635}#) + (if (vector? #{x 3634}#) (begin - (let ((#{n\ 3646}# (vector-length #{x\ 3634}#))) + (let ((#{n 3646}# (vector-length #{x 3634}#))) (begin - (let ((#{v\ 3648}# (make-vector #{n\ 3646}#))) + (let ((#{v 3648}# (make-vector #{n 3646}#))) (letrec* - ((#{loop\ 3651}# - (lambda (#{i\ 3652}#) - (if (= #{i\ 3652}# #{n\ 3646}#) - (begin (if #f #f) #{v\ 3648}#) + ((#{loop 3651}# + (lambda (#{i 3652}#) + (if (= #{i 3652}# #{n 3646}#) + (begin (if #f #f) #{v 3648}#) (begin (vector-set! - #{v\ 3648}# - #{i\ 3652}# - (#{remodulate\ 3633}# + #{v 3648}# + #{i 3652}# + (#{remodulate 3633}# (vector-ref - #{x\ 3634}# - #{i\ 3652}#) - #{mod\ 3635}#)) - (#{loop\ 3651}# - (1+ #{i\ 3652}#))))))) - (begin (#{loop\ 3651}# 0))))))) - #{x\ 3634}#)))))) + #{x 3634}# + #{i 3652}#) + #{mod 3635}#)) + (#{loop 3651}# + (#{1+}# #{i 3652}#))))))) + (begin (#{loop 3651}# 0))))))) + #{x 3634}#)))))) (begin - (let ((#{tmp\ 3658}# #{e\ 3626}#)) - (let ((#{tmp\ 3659}# - ($sc-dispatch #{tmp\ 3658}# '(_ each-any any)))) - (if (if #{tmp\ 3659}# + (let ((#{tmp 3658}# #{e 3626}#)) + (let ((#{tmp 3659}# + ($sc-dispatch #{tmp 3658}# '(_ each-any any)))) + (if (if #{tmp 3659}# (@apply - (lambda (#{mod\ 3662}# #{exp\ 3663}#) - (and-map #{id?\ 376}# #{mod\ 3662}#)) - #{tmp\ 3659}#) + (lambda (#{mod 3662}# #{exp 3663}#) + (and-map #{id? 376}# #{mod 3662}#)) + #{tmp 3659}#) #f) (@apply - (lambda (#{mod\ 3667}# #{exp\ 3668}#) + (lambda (#{mod 3667}# #{exp 3668}#) (begin - (let ((#{mod\ 3670}# + (let ((#{mod 3670}# (syntax->datum (cons '#(syntax-object private @@ -11570,176 +11513,171 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile)) - #{mod\ 3667}#)))) + #{mod 3667}#)))) (values - (#{remodulate\ 3633}# - #{exp\ 3668}# - #{mod\ 3670}#) - #{r\ 3627}# - #{w\ 3628}# - (#{source-annotation\ 357}# #{exp\ 3668}#) - #{mod\ 3670}#)))) - #{tmp\ 3659}#) + (#{remodulate 3633}# + #{exp 3668}# + #{mod 3670}#) + #{r 3627}# + #{w 3628}# + (#{source-annotation 357}# #{exp 3668}#) + #{mod 3670}#)))) + #{tmp 3659}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3658}#)))))))) - (#{global-extend\ 372}# + #{tmp 3658}#)))))))) + (#{global-extend 372}# 'core 'if - (lambda (#{e\ 3672}# - #{r\ 3673}# - #{w\ 3674}# - #{s\ 3675}# - #{mod\ 3676}#) - (let ((#{tmp\ 3682}# #{e\ 3672}#)) - (let ((#{tmp\ 3683}# - ($sc-dispatch #{tmp\ 3682}# '(_ any any)))) - (if #{tmp\ 3683}# + (lambda (#{e 3672}# + #{r 3673}# + #{w 3674}# + #{s 3675}# + #{mod 3676}#) + (let ((#{tmp 3682}# #{e 3672}#)) + (let ((#{tmp 3683}# + ($sc-dispatch #{tmp 3682}# '(_ any any)))) + (if #{tmp 3683}# (@apply - (lambda (#{test\ 3686}# #{then\ 3687}#) - (#{build-conditional\ 304}# - #{s\ 3675}# - (#{chi\ 456}# - #{test\ 3686}# - #{r\ 3673}# - #{w\ 3674}# - #{mod\ 3676}#) - (#{chi\ 456}# - #{then\ 3687}# - #{r\ 3673}# - #{w\ 3674}# - #{mod\ 3676}#) - (#{build-void\ 300}# #f))) - #{tmp\ 3683}#) - (let ((#{tmp\ 3689}# - ($sc-dispatch #{tmp\ 3682}# '(_ any any any)))) - (if #{tmp\ 3689}# + (lambda (#{test 3686}# #{then 3687}#) + (#{build-conditional 304}# + #{s 3675}# + (#{chi 456}# + #{test 3686}# + #{r 3673}# + #{w 3674}# + #{mod 3676}#) + (#{chi 456}# + #{then 3687}# + #{r 3673}# + #{w 3674}# + #{mod 3676}#) + (#{build-void 300}# #f))) + #{tmp 3683}#) + (let ((#{tmp 3689}# + ($sc-dispatch #{tmp 3682}# '(_ any any any)))) + (if #{tmp 3689}# (@apply - (lambda (#{test\ 3693}# - #{then\ 3694}# - #{else\ 3695}#) - (#{build-conditional\ 304}# - #{s\ 3675}# - (#{chi\ 456}# - #{test\ 3693}# - #{r\ 3673}# - #{w\ 3674}# - #{mod\ 3676}#) - (#{chi\ 456}# - #{then\ 3694}# - #{r\ 3673}# - #{w\ 3674}# - #{mod\ 3676}#) - (#{chi\ 456}# - #{else\ 3695}# - #{r\ 3673}# - #{w\ 3674}# - #{mod\ 3676}#))) - #{tmp\ 3689}#) + (lambda (#{test 3693}# #{then 3694}# #{else 3695}#) + (#{build-conditional 304}# + #{s 3675}# + (#{chi 456}# + #{test 3693}# + #{r 3673}# + #{w 3674}# + #{mod 3676}#) + (#{chi 456}# + #{then 3694}# + #{r 3673}# + #{w 3674}# + #{mod 3676}#) + (#{chi 456}# + #{else 3695}# + #{r 3673}# + #{w 3674}# + #{mod 3676}#))) + #{tmp 3689}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3682}#)))))))) - (#{global-extend\ 372}# + #{tmp 3682}#)))))))) + (#{global-extend 372}# 'core 'with-fluids - (lambda (#{e\ 3696}# - #{r\ 3697}# - #{w\ 3698}# - #{s\ 3699}# - #{mod\ 3700}#) - (let ((#{tmp\ 3706}# #{e\ 3696}#)) - (let ((#{tmp\ 3707}# + (lambda (#{e 3696}# + #{r 3697}# + #{w 3698}# + #{s 3699}# + #{mod 3700}#) + (let ((#{tmp 3706}# #{e 3696}#)) + (let ((#{tmp 3707}# ($sc-dispatch - #{tmp\ 3706}# + #{tmp 3706}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 3707}# + (if #{tmp 3707}# (@apply - (lambda (#{fluid\ 3712}# - #{val\ 3713}# - #{b\ 3714}# - #{b*\ 3715}#) - (#{build-dynlet\ 306}# - #{s\ 3699}# - (map (lambda (#{x\ 3716}#) - (#{chi\ 456}# - #{x\ 3716}# - #{r\ 3697}# - #{w\ 3698}# - #{mod\ 3700}#)) - #{fluid\ 3712}#) - (map (lambda (#{x\ 3719}#) - (#{chi\ 456}# - #{x\ 3719}# - #{r\ 3697}# - #{w\ 3698}# - #{mod\ 3700}#)) - #{val\ 3713}#) - (#{chi-body\ 464}# - (cons #{b\ 3714}# #{b*\ 3715}#) - (#{source-wrap\ 444}# - #{e\ 3696}# - #{w\ 3698}# - #{s\ 3699}# - #{mod\ 3700}#) - #{r\ 3697}# - #{w\ 3698}# - #{mod\ 3700}#))) - #{tmp\ 3707}#) + (lambda (#{fluid 3712}# + #{val 3713}# + #{b 3714}# + #{b* 3715}#) + (#{build-dynlet 306}# + #{s 3699}# + (map (lambda (#{x 3716}#) + (#{chi 456}# + #{x 3716}# + #{r 3697}# + #{w 3698}# + #{mod 3700}#)) + #{fluid 3712}#) + (map (lambda (#{x 3719}#) + (#{chi 456}# + #{x 3719}# + #{r 3697}# + #{w 3698}# + #{mod 3700}#)) + #{val 3713}#) + (#{chi-body 464}# + (cons #{b 3714}# #{b* 3715}#) + (#{source-wrap 444}# + #{e 3696}# + #{w 3698}# + #{s 3699}# + #{mod 3700}#) + #{r 3697}# + #{w 3698}# + #{mod 3700}#))) + #{tmp 3707}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3706}#)))))) - (#{global-extend\ 372}# 'begin 'begin '()) - (#{global-extend\ 372}# 'define 'define '()) - (#{global-extend\ 372}# + #{tmp 3706}#)))))) + (#{global-extend 372}# 'begin 'begin '()) + (#{global-extend 372}# 'define 'define '()) + (#{global-extend 372}# 'define-syntax 'define-syntax '()) - (#{global-extend\ 372}# - 'eval-when - 'eval-when - '()) - (#{global-extend\ 372}# + (#{global-extend 372}# 'eval-when 'eval-when '()) + (#{global-extend 372}# 'core 'syntax-case (letrec* - ((#{convert-pattern\ 3724}# - (lambda (#{pattern\ 3731}# #{keys\ 3732}#) + ((#{convert-pattern 3724}# + (lambda (#{pattern 3731}# #{keys 3732}#) (letrec* - ((#{cvt*\ 3736}# - (lambda (#{p*\ 3739}# #{n\ 3740}# #{ids\ 3741}#) - (if (null? #{p*\ 3739}#) - (values '() #{ids\ 3741}#) + ((#{cvt* 3736}# + (lambda (#{p* 3739}# #{n 3740}# #{ids 3741}#) + (if (null? #{p* 3739}#) + (values '() #{ids 3741}#) (call-with-values (lambda () - (#{cvt*\ 3736}# - (cdr #{p*\ 3739}#) - #{n\ 3740}# - #{ids\ 3741}#)) - (lambda (#{y\ 3745}# #{ids\ 3746}#) + (#{cvt* 3736}# + (cdr #{p* 3739}#) + #{n 3740}# + #{ids 3741}#)) + (lambda (#{y 3745}# #{ids 3746}#) (call-with-values (lambda () - (#{cvt\ 3738}# - (car #{p*\ 3739}#) - #{n\ 3740}# - #{ids\ 3746}#)) - (lambda (#{x\ 3749}# #{ids\ 3750}#) + (#{cvt 3738}# + (car #{p* 3739}#) + #{n 3740}# + #{ids 3746}#)) + (lambda (#{x 3749}# #{ids 3750}#) (values - (cons #{x\ 3749}# #{y\ 3745}#) - #{ids\ 3750}#)))))))) - (#{cvt\ 3738}# - (lambda (#{p\ 3753}# #{n\ 3754}# #{ids\ 3755}#) - (if (#{id?\ 376}# #{p\ 3753}#) - (if (#{bound-id-member?\ 440}# - #{p\ 3753}# - #{keys\ 3732}#) + (cons #{x 3749}# #{y 3745}#) + #{ids 3750}#)))))))) + (#{cvt 3738}# + (lambda (#{p 3753}# #{n 3754}# #{ids 3755}#) + (if (#{id? 376}# #{p 3753}#) + (if (#{bound-id-member? 440}# + #{p 3753}# + #{keys 3732}#) (values - (vector 'free-id #{p\ 3753}#) - #{ids\ 3755}#) - (if (#{free-id=?\ 432}# - #{p\ 3753}# + (vector 'free-id #{p 3753}#) + #{ids 3755}#) + (if (#{free-id=? 432}# + #{p 3753}# '#(syntax-object _ ((top) @@ -12180,311 +12118,308 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile))) - (values '_ #{ids\ 3755}#) + (values '_ #{ids 3755}#) (values 'any - (cons (cons #{p\ 3753}# #{n\ 3754}#) - #{ids\ 3755}#)))) - (let ((#{tmp\ 3764}# #{p\ 3753}#)) - (let ((#{tmp\ 3765}# - ($sc-dispatch #{tmp\ 3764}# '(any any)))) - (if (if #{tmp\ 3765}# + (cons (cons #{p 3753}# #{n 3754}#) + #{ids 3755}#)))) + (let ((#{tmp 3764}# #{p 3753}#)) + (let ((#{tmp 3765}# + ($sc-dispatch #{tmp 3764}# '(any any)))) + (if (if #{tmp 3765}# (@apply - (lambda (#{x\ 3768}# #{dots\ 3769}#) - (#{ellipsis?\ 472}# #{dots\ 3769}#)) - #{tmp\ 3765}#) + (lambda (#{x 3768}# #{dots 3769}#) + (#{ellipsis? 472}# #{dots 3769}#)) + #{tmp 3765}#) #f) (@apply - (lambda (#{x\ 3772}# #{dots\ 3773}#) + (lambda (#{x 3772}# #{dots 3773}#) (call-with-values (lambda () - (#{cvt\ 3738}# - #{x\ 3772}# - (1+ #{n\ 3754}#) - #{ids\ 3755}#)) - (lambda (#{p\ 3775}# #{ids\ 3776}#) + (#{cvt 3738}# + #{x 3772}# + (#{1+}# #{n 3754}#) + #{ids 3755}#)) + (lambda (#{p 3775}# #{ids 3776}#) (values - (if (eq? #{p\ 3775}# 'any) + (if (eq? #{p 3775}# 'any) 'each-any - (vector 'each #{p\ 3775}#)) - #{ids\ 3776}#)))) - #{tmp\ 3765}#) - (let ((#{tmp\ 3779}# + (vector 'each #{p 3775}#)) + #{ids 3776}#)))) + #{tmp 3765}#) + (let ((#{tmp 3779}# ($sc-dispatch - #{tmp\ 3764}# + #{tmp 3764}# '(any any . each-any)))) - (if (if #{tmp\ 3779}# + (if (if #{tmp 3779}# (@apply - (lambda (#{x\ 3783}# - #{dots\ 3784}# - #{ys\ 3785}#) - (#{ellipsis?\ 472}# - #{dots\ 3784}#)) - #{tmp\ 3779}#) + (lambda (#{x 3783}# + #{dots 3784}# + #{ys 3785}#) + (#{ellipsis? 472}# + #{dots 3784}#)) + #{tmp 3779}#) #f) (@apply - (lambda (#{x\ 3789}# - #{dots\ 3790}# - #{ys\ 3791}#) + (lambda (#{x 3789}# + #{dots 3790}# + #{ys 3791}#) (call-with-values (lambda () - (#{cvt*\ 3736}# - #{ys\ 3791}# - #{n\ 3754}# - #{ids\ 3755}#)) - (lambda (#{ys\ 3793}# - #{ids\ 3794}#) + (#{cvt* 3736}# + #{ys 3791}# + #{n 3754}# + #{ids 3755}#)) + (lambda (#{ys 3793}# #{ids 3794}#) (call-with-values (lambda () - (#{cvt\ 3738}# - #{x\ 3789}# - (1+ #{n\ 3754}#) - #{ids\ 3794}#)) - (lambda (#{x\ 3797}# - #{ids\ 3798}#) + (#{cvt 3738}# + #{x 3789}# + (#{1+}# #{n 3754}#) + #{ids 3794}#)) + (lambda (#{x 3797}# + #{ids 3798}#) (values (vector 'each+ - #{x\ 3797}# - (reverse #{ys\ 3793}#) + #{x 3797}# + (reverse #{ys 3793}#) '()) - #{ids\ 3798}#)))))) - #{tmp\ 3779}#) - (let ((#{tmp\ 3802}# + #{ids 3798}#)))))) + #{tmp 3779}#) + (let ((#{tmp 3802}# ($sc-dispatch - #{tmp\ 3764}# + #{tmp 3764}# '(any . any)))) - (if #{tmp\ 3802}# + (if #{tmp 3802}# (@apply - (lambda (#{x\ 3805}# #{y\ 3806}#) + (lambda (#{x 3805}# #{y 3806}#) (call-with-values (lambda () - (#{cvt\ 3738}# - #{y\ 3806}# - #{n\ 3754}# - #{ids\ 3755}#)) - (lambda (#{y\ 3807}# - #{ids\ 3808}#) + (#{cvt 3738}# + #{y 3806}# + #{n 3754}# + #{ids 3755}#)) + (lambda (#{y 3807}# + #{ids 3808}#) (call-with-values (lambda () - (#{cvt\ 3738}# - #{x\ 3805}# - #{n\ 3754}# - #{ids\ 3808}#)) - (lambda (#{x\ 3811}# - #{ids\ 3812}#) + (#{cvt 3738}# + #{x 3805}# + #{n 3754}# + #{ids 3808}#)) + (lambda (#{x 3811}# + #{ids 3812}#) (values - (cons #{x\ 3811}# - #{y\ 3807}#) - #{ids\ 3812}#)))))) - #{tmp\ 3802}#) - (let ((#{tmp\ 3815}# + (cons #{x 3811}# + #{y 3807}#) + #{ids 3812}#)))))) + #{tmp 3802}#) + (let ((#{tmp 3815}# ($sc-dispatch - #{tmp\ 3764}# + #{tmp 3764}# '()))) - (if #{tmp\ 3815}# + (if #{tmp 3815}# (@apply (lambda () - (values '() #{ids\ 3755}#)) - #{tmp\ 3815}#) - (let ((#{tmp\ 3816}# + (values '() #{ids 3755}#)) + #{tmp 3815}#) + (let ((#{tmp 3816}# ($sc-dispatch - #{tmp\ 3764}# + #{tmp 3764}# '#(vector each-any)))) - (if #{tmp\ 3816}# + (if #{tmp 3816}# (@apply - (lambda (#{x\ 3818}#) + (lambda (#{x 3818}#) (call-with-values (lambda () - (#{cvt\ 3738}# - #{x\ 3818}# - #{n\ 3754}# - #{ids\ 3755}#)) - (lambda (#{p\ 3820}# - #{ids\ 3821}#) + (#{cvt 3738}# + #{x 3818}# + #{n 3754}# + #{ids 3755}#)) + (lambda (#{p 3820}# + #{ids 3821}#) (values (vector 'vector - #{p\ 3820}#) - #{ids\ 3821}#)))) - #{tmp\ 3816}#) - (let ((#{x\ 3825}# - #{tmp\ 3764}#)) + #{p 3820}#) + #{ids 3821}#)))) + #{tmp 3816}#) + (let ((#{x 3825}# + #{tmp 3764}#)) (values (vector 'atom - (#{strip\ 482}# - #{p\ 3753}# + (#{strip 482}# + #{p 3753}# '(()))) - #{ids\ 3755}#))))))))))))))))) - (begin (#{cvt\ 3738}# #{pattern\ 3731}# 0 '()))))) - (#{build-dispatch-call\ 3726}# - (lambda (#{pvars\ 3827}# - #{exp\ 3828}# - #{y\ 3829}# - #{r\ 3830}# - #{mod\ 3831}#) + #{ids 3755}#))))))))))))))))) + (begin (#{cvt 3738}# #{pattern 3731}# 0 '()))))) + (#{build-dispatch-call 3726}# + (lambda (#{pvars 3827}# + #{exp 3828}# + #{y 3829}# + #{r 3830}# + #{mod 3831}#) (begin - (map cdr #{pvars\ 3827}#) - (let ((#{ids\ 3839}# (map car #{pvars\ 3827}#))) + (map cdr #{pvars 3827}#) + (let ((#{ids 3839}# (map car #{pvars 3827}#))) (begin - (let ((#{labels\ 3843}# - (#{gen-labels\ 391}# #{ids\ 3839}#)) - (#{new-vars\ 3844}# - (map #{gen-var\ 484}# #{ids\ 3839}#))) - (#{build-application\ 302}# + (let ((#{labels 3843}# + (#{gen-labels 391}# #{ids 3839}#)) + (#{new-vars 3844}# + (map #{gen-var 484}# #{ids 3839}#))) + (#{build-application 302}# #f - (#{build-primref\ 326}# #f 'apply) - (list (#{build-simple-lambda\ 320}# + (#{build-primref 326}# #f 'apply) + (list (#{build-simple-lambda 320}# #f - (map syntax->datum #{ids\ 3839}#) + (map syntax->datum #{ids 3839}#) #f - #{new-vars\ 3844}# + #{new-vars 3844}# '() - (#{chi\ 456}# - #{exp\ 3828}# - (#{extend-env\ 364}# - #{labels\ 3843}# - (map (lambda (#{var\ 3848}# - #{level\ 3849}#) + (#{chi 456}# + #{exp 3828}# + (#{extend-env 364}# + #{labels 3843}# + (map (lambda (#{var 3848}# + #{level 3849}#) (cons 'syntax - (cons #{var\ 3848}# - #{level\ 3849}#))) - #{new-vars\ 3844}# - (map cdr #{pvars\ 3827}#)) - #{r\ 3830}#) - (#{make-binding-wrap\ 420}# - #{ids\ 3839}# - #{labels\ 3843}# + (cons #{var 3848}# + #{level 3849}#))) + #{new-vars 3844}# + (map cdr #{pvars 3827}#)) + #{r 3830}#) + (#{make-binding-wrap 420}# + #{ids 3839}# + #{labels 3843}# '(())) - #{mod\ 3831}#)) - #{y\ 3829}#)))))))) - (#{gen-clause\ 3728}# - (lambda (#{x\ 3855}# - #{keys\ 3856}# - #{clauses\ 3857}# - #{r\ 3858}# - #{pat\ 3859}# - #{fender\ 3860}# - #{exp\ 3861}# - #{mod\ 3862}#) + #{mod 3831}#)) + #{y 3829}#)))))))) + (#{gen-clause 3728}# + (lambda (#{x 3855}# + #{keys 3856}# + #{clauses 3857}# + #{r 3858}# + #{pat 3859}# + #{fender 3860}# + #{exp 3861}# + #{mod 3862}#) (call-with-values (lambda () - (#{convert-pattern\ 3724}# - #{pat\ 3859}# - #{keys\ 3856}#)) - (lambda (#{p\ 3871}# #{pvars\ 3872}#) - (if (not (#{distinct-bound-ids?\ 438}# - (map car #{pvars\ 3872}#))) + (#{convert-pattern 3724}# + #{pat 3859}# + #{keys 3856}#)) + (lambda (#{p 3871}# #{pvars 3872}#) + (if (not (#{distinct-bound-ids? 438}# + (map car #{pvars 3872}#))) (syntax-violation 'syntax-case "duplicate pattern variable" - #{pat\ 3859}#) + #{pat 3859}#) (if (not (and-map - (lambda (#{x\ 3879}#) - (not (#{ellipsis?\ 472}# - (car #{x\ 3879}#)))) - #{pvars\ 3872}#)) + (lambda (#{x 3879}#) + (not (#{ellipsis? 472}# + (car #{x 3879}#)))) + #{pvars 3872}#)) (syntax-violation 'syntax-case "misplaced ellipsis" - #{pat\ 3859}#) + #{pat 3859}#) (begin - (let ((#{y\ 3883}# (#{gen-var\ 484}# 'tmp))) - (#{build-application\ 302}# + (let ((#{y 3883}# (#{gen-var 484}# 'tmp))) + (#{build-application 302}# #f - (#{build-simple-lambda\ 320}# + (#{build-simple-lambda 320}# #f (list 'tmp) #f - (list #{y\ 3883}#) + (list #{y 3883}#) '() (begin - (let ((#{y\ 3887}# - (#{build-lexical-reference\ 308}# + (let ((#{y 3887}# + (#{build-lexical-reference 308}# 'value #f 'tmp - #{y\ 3883}#))) - (#{build-conditional\ 304}# + #{y 3883}#))) + (#{build-conditional 304}# #f - (let ((#{tmp\ 3890}# - #{fender\ 3860}#)) - (let ((#{tmp\ 3891}# + (let ((#{tmp 3890}# #{fender 3860}#)) + (let ((#{tmp 3891}# ($sc-dispatch - #{tmp\ 3890}# + #{tmp 3890}# '#(atom #t)))) - (if #{tmp\ 3891}# + (if #{tmp 3891}# (@apply - (lambda () #{y\ 3887}#) - #{tmp\ 3891}#) - (let ((#{_\ 3893}# - #{tmp\ 3890}#)) - (#{build-conditional\ 304}# + (lambda () #{y 3887}#) + #{tmp 3891}#) + (let ((#{_ 3893}# #{tmp 3890}#)) + (#{build-conditional 304}# #f - #{y\ 3887}# - (#{build-dispatch-call\ 3726}# - #{pvars\ 3872}# - #{fender\ 3860}# - #{y\ 3887}# - #{r\ 3858}# - #{mod\ 3862}#) - (#{build-data\ 328}# + #{y 3887}# + (#{build-dispatch-call 3726}# + #{pvars 3872}# + #{fender 3860}# + #{y 3887}# + #{r 3858}# + #{mod 3862}#) + (#{build-data 328}# #f #f)))))) - (#{build-dispatch-call\ 3726}# - #{pvars\ 3872}# - #{exp\ 3861}# - #{y\ 3887}# - #{r\ 3858}# - #{mod\ 3862}#) - (#{gen-syntax-case\ 3730}# - #{x\ 3855}# - #{keys\ 3856}# - #{clauses\ 3857}# - #{r\ 3858}# - #{mod\ 3862}#))))) - (list (if (eq? #{p\ 3871}# 'any) - (#{build-application\ 302}# + (#{build-dispatch-call 3726}# + #{pvars 3872}# + #{exp 3861}# + #{y 3887}# + #{r 3858}# + #{mod 3862}#) + (#{gen-syntax-case 3730}# + #{x 3855}# + #{keys 3856}# + #{clauses 3857}# + #{r 3858}# + #{mod 3862}#))))) + (list (if (eq? #{p 3871}# 'any) + (#{build-application 302}# #f - (#{build-primref\ 326}# #f 'list) - (list #{x\ 3855}#)) - (#{build-application\ 302}# + (#{build-primref 326}# #f 'list) + (list #{x 3855}#)) + (#{build-application 302}# #f - (#{build-primref\ 326}# + (#{build-primref 326}# #f '$sc-dispatch) - (list #{x\ 3855}# - (#{build-data\ 328}# + (list #{x 3855}# + (#{build-data 328}# #f - #{p\ 3871}#)))))))))))))) - (#{gen-syntax-case\ 3730}# - (lambda (#{x\ 3901}# - #{keys\ 3902}# - #{clauses\ 3903}# - #{r\ 3904}# - #{mod\ 3905}#) - (if (null? #{clauses\ 3903}#) - (#{build-application\ 302}# + #{p 3871}#)))))))))))))) + (#{gen-syntax-case 3730}# + (lambda (#{x 3901}# + #{keys 3902}# + #{clauses 3903}# + #{r 3904}# + #{mod 3905}#) + (if (null? #{clauses 3903}#) + (#{build-application 302}# #f - (#{build-primref\ 326}# #f 'syntax-violation) - (list (#{build-data\ 328}# #f #f) - (#{build-data\ 328}# + (#{build-primref 326}# #f 'syntax-violation) + (list (#{build-data 328}# #f #f) + (#{build-data 328}# #f "source expression failed to match any pattern") - #{x\ 3901}#)) - (let ((#{tmp\ 3915}# (car #{clauses\ 3903}#))) - (let ((#{tmp\ 3916}# - ($sc-dispatch #{tmp\ 3915}# '(any any)))) - (if #{tmp\ 3916}# + #{x 3901}#)) + (let ((#{tmp 3915}# (car #{clauses 3903}#))) + (let ((#{tmp 3916}# + ($sc-dispatch #{tmp 3915}# '(any any)))) + (if #{tmp 3916}# (@apply - (lambda (#{pat\ 3919}# #{exp\ 3920}#) - (if (if (#{id?\ 376}# #{pat\ 3919}#) + (lambda (#{pat 3919}# #{exp 3920}#) + (if (if (#{id? 376}# #{pat 3919}#) (and-map - (lambda (#{x\ 3923}#) - (not (#{free-id=?\ 432}# - #{pat\ 3919}# - #{x\ 3923}#))) + (lambda (#{x 3923}#) + (not (#{free-id=? 432}# + #{pat 3919}# + #{x 3923}#))) (cons '#(syntax-object ... ((top) @@ -12932,9 +12867,9 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile)) - #{keys\ 3902}#)) + #{keys 3902}#)) #f) - (if (#{free-id=?\ 432}# + (if (#{free-id=? 432}# '#(syntax-object pad ((top) @@ -13815,582 +13750,567 @@ ((top) (top) (top) (top)) ("i41" "i40" "i39" "i37"))) (hygiene guile))) - (#{chi\ 456}# - #{exp\ 3920}# - #{r\ 3904}# + (#{chi 456}# + #{exp 3920}# + #{r 3904}# '(()) - #{mod\ 3905}#) + #{mod 3905}#) (begin - (let ((#{labels\ 3928}# - (list (#{gen-label\ 389}#))) - (#{var\ 3929}# - (#{gen-var\ 484}# #{pat\ 3919}#))) - (#{build-application\ 302}# + (let ((#{labels 3928}# + (list (#{gen-label 389}#))) + (#{var 3929}# + (#{gen-var 484}# #{pat 3919}#))) + (#{build-application 302}# #f - (#{build-simple-lambda\ 320}# + (#{build-simple-lambda 320}# #f - (list (syntax->datum #{pat\ 3919}#)) + (list (syntax->datum #{pat 3919}#)) #f - (list #{var\ 3929}#) + (list #{var 3929}#) '() - (#{chi\ 456}# - #{exp\ 3920}# - (#{extend-env\ 364}# - #{labels\ 3928}# + (#{chi 456}# + #{exp 3920}# + (#{extend-env 364}# + #{labels 3928}# (list (cons 'syntax - (cons #{var\ 3929}# + (cons #{var 3929}# 0))) - #{r\ 3904}#) - (#{make-binding-wrap\ 420}# - (list #{pat\ 3919}#) - #{labels\ 3928}# + #{r 3904}#) + (#{make-binding-wrap 420}# + (list #{pat 3919}#) + #{labels 3928}# '(())) - #{mod\ 3905}#)) - (list #{x\ 3901}#))))) - (#{gen-clause\ 3728}# - #{x\ 3901}# - #{keys\ 3902}# - (cdr #{clauses\ 3903}#) - #{r\ 3904}# - #{pat\ 3919}# + #{mod 3905}#)) + (list #{x 3901}#))))) + (#{gen-clause 3728}# + #{x 3901}# + #{keys 3902}# + (cdr #{clauses 3903}#) + #{r 3904}# + #{pat 3919}# #t - #{exp\ 3920}# - #{mod\ 3905}#))) - #{tmp\ 3916}#) - (let ((#{tmp\ 3935}# - ($sc-dispatch - #{tmp\ 3915}# - '(any any any)))) - (if #{tmp\ 3935}# + #{exp 3920}# + #{mod 3905}#))) + #{tmp 3916}#) + (let ((#{tmp 3935}# + ($sc-dispatch #{tmp 3915}# '(any any any)))) + (if #{tmp 3935}# (@apply - (lambda (#{pat\ 3939}# - #{fender\ 3940}# - #{exp\ 3941}#) - (#{gen-clause\ 3728}# - #{x\ 3901}# - #{keys\ 3902}# - (cdr #{clauses\ 3903}#) - #{r\ 3904}# - #{pat\ 3939}# - #{fender\ 3940}# - #{exp\ 3941}# - #{mod\ 3905}#)) - #{tmp\ 3935}#) - (let ((#{_\ 3943}# #{tmp\ 3915}#)) + (lambda (#{pat 3939}# + #{fender 3940}# + #{exp 3941}#) + (#{gen-clause 3728}# + #{x 3901}# + #{keys 3902}# + (cdr #{clauses 3903}#) + #{r 3904}# + #{pat 3939}# + #{fender 3940}# + #{exp 3941}# + #{mod 3905}#)) + #{tmp 3935}#) + (let ((#{_ 3943}# #{tmp 3915}#)) (syntax-violation 'syntax-case "invalid clause" - (car #{clauses\ 3903}#)))))))))))) + (car #{clauses 3903}#)))))))))))) (begin - (lambda (#{e\ 3944}# - #{r\ 3945}# - #{w\ 3946}# - #{s\ 3947}# - #{mod\ 3948}#) + (lambda (#{e 3944}# + #{r 3945}# + #{w 3946}# + #{s 3947}# + #{mod 3948}#) (begin - (let ((#{e\ 3955}# - (#{source-wrap\ 444}# - #{e\ 3944}# - #{w\ 3946}# - #{s\ 3947}# - #{mod\ 3948}#))) - (let ((#{tmp\ 3956}# #{e\ 3955}#)) - (let ((#{tmp\ 3957}# + (let ((#{e 3955}# + (#{source-wrap 444}# + #{e 3944}# + #{w 3946}# + #{s 3947}# + #{mod 3948}#))) + (let ((#{tmp 3956}# #{e 3955}#)) + (let ((#{tmp 3957}# ($sc-dispatch - #{tmp\ 3956}# + #{tmp 3956}# '(_ any each-any . each-any)))) - (if #{tmp\ 3957}# + (if #{tmp 3957}# (@apply - (lambda (#{val\ 3961}# #{key\ 3962}# #{m\ 3963}#) + (lambda (#{val 3961}# #{key 3962}# #{m 3963}#) (if (and-map - (lambda (#{x\ 3964}#) - (if (#{id?\ 376}# #{x\ 3964}#) - (not (#{ellipsis?\ 472}# - #{x\ 3964}#)) + (lambda (#{x 3964}#) + (if (#{id? 376}# #{x 3964}#) + (not (#{ellipsis? 472}# #{x 3964}#)) #f)) - #{key\ 3962}#) + #{key 3962}#) (begin - (let ((#{x\ 3970}# - (#{gen-var\ 484}# 'tmp))) - (#{build-application\ 302}# - #{s\ 3947}# - (#{build-simple-lambda\ 320}# + (let ((#{x 3970}# (#{gen-var 484}# 'tmp))) + (#{build-application 302}# + #{s 3947}# + (#{build-simple-lambda 320}# #f (list 'tmp) #f - (list #{x\ 3970}#) + (list #{x 3970}#) '() - (#{gen-syntax-case\ 3730}# - (#{build-lexical-reference\ 308}# + (#{gen-syntax-case 3730}# + (#{build-lexical-reference 308}# 'value #f 'tmp - #{x\ 3970}#) - #{key\ 3962}# - #{m\ 3963}# - #{r\ 3945}# - #{mod\ 3948}#)) - (list (#{chi\ 456}# - #{val\ 3961}# - #{r\ 3945}# + #{x 3970}#) + #{key 3962}# + #{m 3963}# + #{r 3945}# + #{mod 3948}#)) + (list (#{chi 456}# + #{val 3961}# + #{r 3945}# '(()) - #{mod\ 3948}#))))) + #{mod 3948}#))))) (syntax-violation 'syntax-case "invalid literals list" - #{e\ 3955}#))) - #{tmp\ 3957}#) + #{e 3955}#))) + #{tmp 3957}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 3956}#)))))))))) + #{tmp 3956}#)))))))))) (set! macroexpand (lambda* - (#{x\ 3976}# + (#{x 3976}# #:optional - (#{m\ 3978}# 'e) - (#{esew\ 3980}# '(eval))) - (#{chi-top-sequence\ 448}# - (list #{x\ 3976}#) + (#{m 3978}# 'e) + (#{esew 3980}# '(eval))) + (#{chi-top-sequence 448}# + (list #{x 3976}#) '() '((top)) #f - #{m\ 3978}# - #{esew\ 3980}# + #{m 3978}# + #{esew 3980}# (cons 'hygiene (module-name (current-module)))))) (set! identifier? - (lambda (#{x\ 3984}#) - (#{nonsymbol-id?\ 374}# #{x\ 3984}#))) + (lambda (#{x 3984}#) + (#{nonsymbol-id? 374}# #{x 3984}#))) (set! datum->syntax - (lambda (#{id\ 3986}# #{datum\ 3987}#) - (#{make-syntax-object\ 340}# - #{datum\ 3987}# - (#{syntax-object-wrap\ 346}# #{id\ 3986}#) - (#{syntax-object-module\ 348}# #{id\ 3986}#)))) + (lambda (#{id 3986}# #{datum 3987}#) + (#{make-syntax-object 340}# + #{datum 3987}# + (#{syntax-object-wrap 346}# #{id 3986}#) + (#{syntax-object-module 348}# #{id 3986}#)))) (set! syntax->datum - (lambda (#{x\ 3990}#) - (#{strip\ 482}# #{x\ 3990}# '(())))) + (lambda (#{x 3990}#) + (#{strip 482}# #{x 3990}# '(())))) (set! syntax-source - (lambda (#{x\ 3993}#) - (#{source-annotation\ 357}# #{x\ 3993}#))) + (lambda (#{x 3993}#) + (#{source-annotation 357}# #{x 3993}#))) (set! generate-temporaries - (lambda (#{ls\ 3995}#) + (lambda (#{ls 3995}#) (begin (begin - (let ((#{x\ 3999}# #{ls\ 3995}#)) - (if (not (list? #{x\ 3999}#)) + (let ((#{x 3999}# #{ls 3995}#)) + (if (not (list? #{x 3999}#)) (syntax-violation 'generate-temporaries "invalid argument" - #{x\ 3999}#)))) - (map (lambda (#{x\ 4000}#) - (#{wrap\ 442}# (gensym) '((top)) #f)) - #{ls\ 3995}#)))) + #{x 3999}#)))) + (map (lambda (#{x 4000}#) + (#{wrap 442}# (gensym) '((top)) #f)) + #{ls 3995}#)))) (set! free-identifier=? - (lambda (#{x\ 4004}# #{y\ 4005}#) + (lambda (#{x 4004}# #{y 4005}#) (begin (begin - (let ((#{x\ 4010}# #{x\ 4004}#)) - (if (not (#{nonsymbol-id?\ 374}# #{x\ 4010}#)) + (let ((#{x 4010}# #{x 4004}#)) + (if (not (#{nonsymbol-id? 374}# #{x 4010}#)) (syntax-violation 'free-identifier=? "invalid argument" - #{x\ 4010}#)))) + #{x 4010}#)))) (begin - (let ((#{x\ 4013}# #{y\ 4005}#)) - (if (not (#{nonsymbol-id?\ 374}# #{x\ 4013}#)) + (let ((#{x 4013}# #{y 4005}#)) + (if (not (#{nonsymbol-id? 374}# #{x 4013}#)) (syntax-violation 'free-identifier=? "invalid argument" - #{x\ 4013}#)))) - (#{free-id=?\ 432}# #{x\ 4004}# #{y\ 4005}#)))) + #{x 4013}#)))) + (#{free-id=? 432}# #{x 4004}# #{y 4005}#)))) (set! bound-identifier=? - (lambda (#{x\ 4014}# #{y\ 4015}#) + (lambda (#{x 4014}# #{y 4015}#) (begin (begin - (let ((#{x\ 4020}# #{x\ 4014}#)) - (if (not (#{nonsymbol-id?\ 374}# #{x\ 4020}#)) + (let ((#{x 4020}# #{x 4014}#)) + (if (not (#{nonsymbol-id? 374}# #{x 4020}#)) (syntax-violation 'bound-identifier=? "invalid argument" - #{x\ 4020}#)))) + #{x 4020}#)))) (begin - (let ((#{x\ 4023}# #{y\ 4015}#)) - (if (not (#{nonsymbol-id?\ 374}# #{x\ 4023}#)) + (let ((#{x 4023}# #{y 4015}#)) + (if (not (#{nonsymbol-id? 374}# #{x 4023}#)) (syntax-violation 'bound-identifier=? "invalid argument" - #{x\ 4023}#)))) - (#{bound-id=?\ 434}# #{x\ 4014}# #{y\ 4015}#)))) + #{x 4023}#)))) + (#{bound-id=? 434}# #{x 4014}# #{y 4015}#)))) (set! syntax-violation (lambda* - (#{who\ 4024}# - #{message\ 4025}# - #{form\ 4026}# + (#{who 4024}# + #{message 4025}# + #{form 4026}# #:optional - (#{subform\ 4030}# #f)) + (#{subform 4030}# #f)) (begin (begin - (let ((#{x\ 4034}# #{who\ 4024}#)) - (if (not (let ((#{x\ 4035}# #{x\ 4034}#)) + (let ((#{x 4034}# #{who 4024}#)) + (if (not (let ((#{x 4035}# #{x 4034}#)) (begin - (let ((#{t\ 4039}# (not #{x\ 4035}#))) - (if #{t\ 4039}# - #{t\ 4039}# + (let ((#{t 4039}# (not #{x 4035}#))) + (if #{t 4039}# + #{t 4039}# (begin - (let ((#{t\ 4042}# - (string? #{x\ 4035}#))) - (if #{t\ 4042}# - #{t\ 4042}# - (symbol? #{x\ 4035}#))))))))) + (let ((#{t 4042}# (string? #{x 4035}#))) + (if #{t 4042}# + #{t 4042}# + (symbol? #{x 4035}#))))))))) (syntax-violation 'syntax-violation "invalid argument" - #{x\ 4034}#)))) + #{x 4034}#)))) (begin - (let ((#{x\ 4046}# #{message\ 4025}#)) - (if (not (string? #{x\ 4046}#)) + (let ((#{x 4046}# #{message 4025}#)) + (if (not (string? #{x 4046}#)) (syntax-violation 'syntax-violation "invalid argument" - #{x\ 4046}#)))) + #{x 4046}#)))) (throw 'syntax-error - #{who\ 4024}# - #{message\ 4025}# - (#{source-annotation\ 357}# + #{who 4024}# + #{message 4025}# + (#{source-annotation 357}# (begin - (let ((#{t\ 4049}# #{form\ 4026}#)) - (if #{t\ 4049}# #{t\ 4049}# #{subform\ 4030}#)))) - (#{strip\ 482}# #{form\ 4026}# '(())) - (if #{subform\ 4030}# - (#{strip\ 482}# #{subform\ 4030}# '(())) + (let ((#{t 4049}# #{form 4026}#)) + (if #{t 4049}# #{t 4049}# #{subform 4030}#)))) + (#{strip 482}# #{form 4026}# '(())) + (if #{subform 4030}# + (#{strip 482}# #{subform 4030}# '(())) #f))))) (letrec* - ((#{match-each\ 4056}# - (lambda (#{e\ 4069}# - #{p\ 4070}# - #{w\ 4071}# - #{mod\ 4072}#) - (if (pair? #{e\ 4069}#) + ((#{match-each 4056}# + (lambda (#{e 4069}# #{p 4070}# #{w 4071}# #{mod 4072}#) + (if (pair? #{e 4069}#) (begin - (let ((#{first\ 4080}# - (#{match\ 4068}# - (car #{e\ 4069}#) - #{p\ 4070}# - #{w\ 4071}# + (let ((#{first 4080}# + (#{match 4068}# + (car #{e 4069}#) + #{p 4070}# + #{w 4071}# '() - #{mod\ 4072}#))) - (if #{first\ 4080}# + #{mod 4072}#))) + (if #{first 4080}# (begin - (let ((#{rest\ 4084}# - (#{match-each\ 4056}# - (cdr #{e\ 4069}#) - #{p\ 4070}# - #{w\ 4071}# - #{mod\ 4072}#))) - (if #{rest\ 4084}# - (cons #{first\ 4080}# #{rest\ 4084}#) + (let ((#{rest 4084}# + (#{match-each 4056}# + (cdr #{e 4069}#) + #{p 4070}# + #{w 4071}# + #{mod 4072}#))) + (if #{rest 4084}# + (cons #{first 4080}# #{rest 4084}#) #f))) #f))) - (if (null? #{e\ 4069}#) + (if (null? #{e 4069}#) '() - (if (#{syntax-object?\ 342}# #{e\ 4069}#) - (#{match-each\ 4056}# - (#{syntax-object-expression\ 344}# #{e\ 4069}#) - #{p\ 4070}# - (#{join-wraps\ 424}# - #{w\ 4071}# - (#{syntax-object-wrap\ 346}# #{e\ 4069}#)) - (#{syntax-object-module\ 348}# #{e\ 4069}#)) + (if (#{syntax-object? 342}# #{e 4069}#) + (#{match-each 4056}# + (#{syntax-object-expression 344}# #{e 4069}#) + #{p 4070}# + (#{join-wraps 424}# + #{w 4071}# + (#{syntax-object-wrap 346}# #{e 4069}#)) + (#{syntax-object-module 348}# #{e 4069}#)) #f))))) - (#{match-each+\ 4058}# - (lambda (#{e\ 4092}# - #{x-pat\ 4093}# - #{y-pat\ 4094}# - #{z-pat\ 4095}# - #{w\ 4096}# - #{r\ 4097}# - #{mod\ 4098}#) + (#{match-each+ 4058}# + (lambda (#{e 4092}# + #{x-pat 4093}# + #{y-pat 4094}# + #{z-pat 4095}# + #{w 4096}# + #{r 4097}# + #{mod 4098}#) (letrec* - ((#{f\ 4109}# - (lambda (#{e\ 4110}# #{w\ 4111}#) - (if (pair? #{e\ 4110}#) + ((#{f 4109}# + (lambda (#{e 4110}# #{w 4111}#) + (if (pair? #{e 4110}#) (call-with-values (lambda () - (#{f\ 4109}# (cdr #{e\ 4110}#) #{w\ 4111}#)) - (lambda (#{xr*\ 4114}# #{y-pat\ 4115}# #{r\ 4116}#) - (if #{r\ 4116}# - (if (null? #{y-pat\ 4115}#) + (#{f 4109}# (cdr #{e 4110}#) #{w 4111}#)) + (lambda (#{xr* 4114}# #{y-pat 4115}# #{r 4116}#) + (if #{r 4116}# + (if (null? #{y-pat 4115}#) (begin - (let ((#{xr\ 4121}# - (#{match\ 4068}# - (car #{e\ 4110}#) - #{x-pat\ 4093}# - #{w\ 4111}# + (let ((#{xr 4121}# + (#{match 4068}# + (car #{e 4110}#) + #{x-pat 4093}# + #{w 4111}# '() - #{mod\ 4098}#))) - (if #{xr\ 4121}# + #{mod 4098}#))) + (if #{xr 4121}# (values - (cons #{xr\ 4121}# #{xr*\ 4114}#) - #{y-pat\ 4115}# - #{r\ 4116}#) + (cons #{xr 4121}# #{xr* 4114}#) + #{y-pat 4115}# + #{r 4116}#) (values #f #f #f)))) (values '() - (cdr #{y-pat\ 4115}#) - (#{match\ 4068}# - (car #{e\ 4110}#) - (car #{y-pat\ 4115}#) - #{w\ 4111}# - #{r\ 4116}# - #{mod\ 4098}#))) + (cdr #{y-pat 4115}#) + (#{match 4068}# + (car #{e 4110}#) + (car #{y-pat 4115}#) + #{w 4111}# + #{r 4116}# + #{mod 4098}#))) (values #f #f #f)))) - (if (#{syntax-object?\ 342}# #{e\ 4110}#) - (#{f\ 4109}# - (#{syntax-object-expression\ 344}# #{e\ 4110}#) - (#{join-wraps\ 424}# #{w\ 4111}# #{e\ 4110}#)) + (if (#{syntax-object? 342}# #{e 4110}#) + (#{f 4109}# + (#{syntax-object-expression 344}# #{e 4110}#) + (#{join-wraps 424}# #{w 4111}# #{e 4110}#)) (values '() - #{y-pat\ 4094}# - (#{match\ 4068}# - #{e\ 4110}# - #{z-pat\ 4095}# - #{w\ 4111}# - #{r\ 4097}# - #{mod\ 4098}#))))))) - (begin (#{f\ 4109}# #{e\ 4092}# #{w\ 4096}#))))) - (#{match-each-any\ 4060}# - (lambda (#{e\ 4125}# #{w\ 4126}# #{mod\ 4127}#) - (if (pair? #{e\ 4125}#) + #{y-pat 4094}# + (#{match 4068}# + #{e 4110}# + #{z-pat 4095}# + #{w 4111}# + #{r 4097}# + #{mod 4098}#))))))) + (begin (#{f 4109}# #{e 4092}# #{w 4096}#))))) + (#{match-each-any 4060}# + (lambda (#{e 4125}# #{w 4126}# #{mod 4127}#) + (if (pair? #{e 4125}#) (begin - (let ((#{l\ 4134}# - (#{match-each-any\ 4060}# - (cdr #{e\ 4125}#) - #{w\ 4126}# - #{mod\ 4127}#))) - (if #{l\ 4134}# - (cons (#{wrap\ 442}# - (car #{e\ 4125}#) - #{w\ 4126}# - #{mod\ 4127}#) - #{l\ 4134}#) + (let ((#{l 4134}# + (#{match-each-any 4060}# + (cdr #{e 4125}#) + #{w 4126}# + #{mod 4127}#))) + (if #{l 4134}# + (cons (#{wrap 442}# + (car #{e 4125}#) + #{w 4126}# + #{mod 4127}#) + #{l 4134}#) #f))) - (if (null? #{e\ 4125}#) + (if (null? #{e 4125}#) '() - (if (#{syntax-object?\ 342}# #{e\ 4125}#) - (#{match-each-any\ 4060}# - (#{syntax-object-expression\ 344}# #{e\ 4125}#) - (#{join-wraps\ 424}# - #{w\ 4126}# - (#{syntax-object-wrap\ 346}# #{e\ 4125}#)) - #{mod\ 4127}#) + (if (#{syntax-object? 342}# #{e 4125}#) + (#{match-each-any 4060}# + (#{syntax-object-expression 344}# #{e 4125}#) + (#{join-wraps 424}# + #{w 4126}# + (#{syntax-object-wrap 346}# #{e 4125}#)) + #{mod 4127}#) #f))))) - (#{match-empty\ 4062}# - (lambda (#{p\ 4142}# #{r\ 4143}#) - (if (null? #{p\ 4142}#) - #{r\ 4143}# - (if (eq? #{p\ 4142}# '_) - #{r\ 4143}# - (if (eq? #{p\ 4142}# 'any) - (cons '() #{r\ 4143}#) - (if (pair? #{p\ 4142}#) - (#{match-empty\ 4062}# - (car #{p\ 4142}#) - (#{match-empty\ 4062}# - (cdr #{p\ 4142}#) - #{r\ 4143}#)) - (if (eq? #{p\ 4142}# 'each-any) - (cons '() #{r\ 4143}#) + (#{match-empty 4062}# + (lambda (#{p 4142}# #{r 4143}#) + (if (null? #{p 4142}#) + #{r 4143}# + (if (eq? #{p 4142}# '_) + #{r 4143}# + (if (eq? #{p 4142}# 'any) + (cons '() #{r 4143}#) + (if (pair? #{p 4142}#) + (#{match-empty 4062}# + (car #{p 4142}#) + (#{match-empty 4062}# + (cdr #{p 4142}#) + #{r 4143}#)) + (if (eq? #{p 4142}# 'each-any) + (cons '() #{r 4143}#) (begin - (let ((#{atom-key\ 4159}# - (vector-ref #{p\ 4142}# 0))) - (if (eqv? #{atom-key\ 4159}# 'each) - (#{match-empty\ 4062}# - (vector-ref #{p\ 4142}# 1) - #{r\ 4143}#) - (if (eqv? #{atom-key\ 4159}# 'each+) - (#{match-empty\ 4062}# - (vector-ref #{p\ 4142}# 1) - (#{match-empty\ 4062}# - (reverse (vector-ref #{p\ 4142}# 2)) - (#{match-empty\ 4062}# - (vector-ref #{p\ 4142}# 3) - #{r\ 4143}#))) - (if (if (eqv? #{atom-key\ 4159}# 'free-id) + (let ((#{atom-key 4159}# + (vector-ref #{p 4142}# 0))) + (if (eqv? #{atom-key 4159}# 'each) + (#{match-empty 4062}# + (vector-ref #{p 4142}# 1) + #{r 4143}#) + (if (eqv? #{atom-key 4159}# 'each+) + (#{match-empty 4062}# + (vector-ref #{p 4142}# 1) + (#{match-empty 4062}# + (reverse (vector-ref #{p 4142}# 2)) + (#{match-empty 4062}# + (vector-ref #{p 4142}# 3) + #{r 4143}#))) + (if (if (eqv? #{atom-key 4159}# 'free-id) #t - (eqv? #{atom-key\ 4159}# 'atom)) - #{r\ 4143}# - (if (eqv? #{atom-key\ 4159}# 'vector) - (#{match-empty\ 4062}# - (vector-ref #{p\ 4142}# 1) - #{r\ 4143}#)))))))))))))) - (#{combine\ 4064}# - (lambda (#{r*\ 4164}# #{r\ 4165}#) - (if (null? (car #{r*\ 4164}#)) - #{r\ 4165}# - (cons (map car #{r*\ 4164}#) - (#{combine\ 4064}# - (map cdr #{r*\ 4164}#) - #{r\ 4165}#))))) - (#{match*\ 4066}# - (lambda (#{e\ 4168}# - #{p\ 4169}# - #{w\ 4170}# - #{r\ 4171}# - #{mod\ 4172}#) - (if (null? #{p\ 4169}#) - (if (null? #{e\ 4168}#) #{r\ 4171}# #f) - (if (pair? #{p\ 4169}#) - (if (pair? #{e\ 4168}#) - (#{match\ 4068}# - (car #{e\ 4168}#) - (car #{p\ 4169}#) - #{w\ 4170}# - (#{match\ 4068}# - (cdr #{e\ 4168}#) - (cdr #{p\ 4169}#) - #{w\ 4170}# - #{r\ 4171}# - #{mod\ 4172}#) - #{mod\ 4172}#) + (eqv? #{atom-key 4159}# 'atom)) + #{r 4143}# + (if (eqv? #{atom-key 4159}# 'vector) + (#{match-empty 4062}# + (vector-ref #{p 4142}# 1) + #{r 4143}#)))))))))))))) + (#{combine 4064}# + (lambda (#{r* 4164}# #{r 4165}#) + (if (null? (car #{r* 4164}#)) + #{r 4165}# + (cons (map car #{r* 4164}#) + (#{combine 4064}# + (map cdr #{r* 4164}#) + #{r 4165}#))))) + (#{match* 4066}# + (lambda (#{e 4168}# + #{p 4169}# + #{w 4170}# + #{r 4171}# + #{mod 4172}#) + (if (null? #{p 4169}#) + (if (null? #{e 4168}#) #{r 4171}# #f) + (if (pair? #{p 4169}#) + (if (pair? #{e 4168}#) + (#{match 4068}# + (car #{e 4168}#) + (car #{p 4169}#) + #{w 4170}# + (#{match 4068}# + (cdr #{e 4168}#) + (cdr #{p 4169}#) + #{w 4170}# + #{r 4171}# + #{mod 4172}#) + #{mod 4172}#) #f) - (if (eq? #{p\ 4169}# 'each-any) + (if (eq? #{p 4169}# 'each-any) (begin - (let ((#{l\ 4189}# - (#{match-each-any\ 4060}# - #{e\ 4168}# - #{w\ 4170}# - #{mod\ 4172}#))) - (if #{l\ 4189}# - (cons #{l\ 4189}# #{r\ 4171}#) - #f))) + (let ((#{l 4189}# + (#{match-each-any 4060}# + #{e 4168}# + #{w 4170}# + #{mod 4172}#))) + (if #{l 4189}# (cons #{l 4189}# #{r 4171}#) #f))) (begin - (let ((#{atom-key\ 4195}# (vector-ref #{p\ 4169}# 0))) - (if (eqv? #{atom-key\ 4195}# 'each) - (if (null? #{e\ 4168}#) - (#{match-empty\ 4062}# - (vector-ref #{p\ 4169}# 1) - #{r\ 4171}#) + (let ((#{atom-key 4195}# (vector-ref #{p 4169}# 0))) + (if (eqv? #{atom-key 4195}# 'each) + (if (null? #{e 4168}#) + (#{match-empty 4062}# + (vector-ref #{p 4169}# 1) + #{r 4171}#) (begin - (let ((#{l\ 4198}# - (#{match-each\ 4056}# - #{e\ 4168}# - (vector-ref #{p\ 4169}# 1) - #{w\ 4170}# - #{mod\ 4172}#))) - (if #{l\ 4198}# + (let ((#{l 4198}# + (#{match-each 4056}# + #{e 4168}# + (vector-ref #{p 4169}# 1) + #{w 4170}# + #{mod 4172}#))) + (if #{l 4198}# (letrec* - ((#{collect\ 4203}# - (lambda (#{l\ 4204}#) - (if (null? (car #{l\ 4204}#)) - #{r\ 4171}# - (cons (map car #{l\ 4204}#) - (#{collect\ 4203}# + ((#{collect 4203}# + (lambda (#{l 4204}#) + (if (null? (car #{l 4204}#)) + #{r 4171}# + (cons (map car #{l 4204}#) + (#{collect 4203}# (map cdr - #{l\ 4204}#))))))) - (begin (#{collect\ 4203}# #{l\ 4198}#))) + #{l 4204}#))))))) + (begin (#{collect 4203}# #{l 4198}#))) #f)))) - (if (eqv? #{atom-key\ 4195}# 'each+) + (if (eqv? #{atom-key 4195}# 'each+) (call-with-values (lambda () - (#{match-each+\ 4058}# - #{e\ 4168}# - (vector-ref #{p\ 4169}# 1) - (vector-ref #{p\ 4169}# 2) - (vector-ref #{p\ 4169}# 3) - #{w\ 4170}# - #{r\ 4171}# - #{mod\ 4172}#)) - (lambda (#{xr*\ 4206}# - #{y-pat\ 4207}# - #{r\ 4208}#) - (if #{r\ 4208}# - (if (null? #{y-pat\ 4207}#) - (if (null? #{xr*\ 4206}#) - (#{match-empty\ 4062}# - (vector-ref #{p\ 4169}# 1) - #{r\ 4208}#) - (#{combine\ 4064}# - #{xr*\ 4206}# - #{r\ 4208}#)) + (#{match-each+ 4058}# + #{e 4168}# + (vector-ref #{p 4169}# 1) + (vector-ref #{p 4169}# 2) + (vector-ref #{p 4169}# 3) + #{w 4170}# + #{r 4171}# + #{mod 4172}#)) + (lambda (#{xr* 4206}# + #{y-pat 4207}# + #{r 4208}#) + (if #{r 4208}# + (if (null? #{y-pat 4207}#) + (if (null? #{xr* 4206}#) + (#{match-empty 4062}# + (vector-ref #{p 4169}# 1) + #{r 4208}#) + (#{combine 4064}# + #{xr* 4206}# + #{r 4208}#)) #f) #f))) - (if (eqv? #{atom-key\ 4195}# 'free-id) - (if (#{id?\ 376}# #{e\ 4168}#) - (if (#{free-id=?\ 432}# - (#{wrap\ 442}# - #{e\ 4168}# - #{w\ 4170}# - #{mod\ 4172}#) - (vector-ref #{p\ 4169}# 1)) - #{r\ 4171}# + (if (eqv? #{atom-key 4195}# 'free-id) + (if (#{id? 376}# #{e 4168}#) + (if (#{free-id=? 432}# + (#{wrap 442}# + #{e 4168}# + #{w 4170}# + #{mod 4172}#) + (vector-ref #{p 4169}# 1)) + #{r 4171}# #f) #f) - (if (eqv? #{atom-key\ 4195}# 'atom) + (if (eqv? #{atom-key 4195}# 'atom) (if (equal? - (vector-ref #{p\ 4169}# 1) - (#{strip\ 482}# - #{e\ 4168}# - #{w\ 4170}#)) - #{r\ 4171}# + (vector-ref #{p 4169}# 1) + (#{strip 482}# #{e 4168}# #{w 4170}#)) + #{r 4171}# #f) - (if (eqv? #{atom-key\ 4195}# 'vector) - (if (vector? #{e\ 4168}#) - (#{match\ 4068}# - (vector->list #{e\ 4168}#) - (vector-ref #{p\ 4169}# 1) - #{w\ 4170}# - #{r\ 4171}# - #{mod\ 4172}#) + (if (eqv? #{atom-key 4195}# 'vector) + (if (vector? #{e 4168}#) + (#{match 4068}# + (vector->list #{e 4168}#) + (vector-ref #{p 4169}# 1) + #{w 4170}# + #{r 4171}# + #{mod 4172}#) #f))))))))))))) - (#{match\ 4068}# - (lambda (#{e\ 4225}# - #{p\ 4226}# - #{w\ 4227}# - #{r\ 4228}# - #{mod\ 4229}#) - (if (not #{r\ 4228}#) + (#{match 4068}# + (lambda (#{e 4225}# + #{p 4226}# + #{w 4227}# + #{r 4228}# + #{mod 4229}#) + (if (not #{r 4228}#) #f - (if (eq? #{p\ 4226}# '_) - #{r\ 4228}# - (if (eq? #{p\ 4226}# 'any) - (cons (#{wrap\ 442}# - #{e\ 4225}# - #{w\ 4227}# - #{mod\ 4229}#) - #{r\ 4228}#) - (if (#{syntax-object?\ 342}# #{e\ 4225}#) - (#{match*\ 4066}# - (#{syntax-object-expression\ 344}# #{e\ 4225}#) - #{p\ 4226}# - (#{join-wraps\ 424}# - #{w\ 4227}# - (#{syntax-object-wrap\ 346}# #{e\ 4225}#)) - #{r\ 4228}# - (#{syntax-object-module\ 348}# #{e\ 4225}#)) - (#{match*\ 4066}# - #{e\ 4225}# - #{p\ 4226}# - #{w\ 4227}# - #{r\ 4228}# - #{mod\ 4229}#)))))))) + (if (eq? #{p 4226}# '_) + #{r 4228}# + (if (eq? #{p 4226}# 'any) + (cons (#{wrap 442}# #{e 4225}# #{w 4227}# #{mod 4229}#) + #{r 4228}#) + (if (#{syntax-object? 342}# #{e 4225}#) + (#{match* 4066}# + (#{syntax-object-expression 344}# #{e 4225}#) + #{p 4226}# + (#{join-wraps 424}# + #{w 4227}# + (#{syntax-object-wrap 346}# #{e 4225}#)) + #{r 4228}# + (#{syntax-object-module 348}# #{e 4225}#)) + (#{match* 4066}# + #{e 4225}# + #{p 4226}# + #{w 4227}# + #{r 4228}# + #{mod 4229}#)))))))) (begin (set! $sc-dispatch - (lambda (#{e\ 4244}# #{p\ 4245}#) - (if (eq? #{p\ 4245}# 'any) - (list #{e\ 4244}#) - (if (eq? #{p\ 4245}# '_) + (lambda (#{e 4244}# #{p 4245}#) + (if (eq? #{p 4245}# 'any) + (list #{e 4244}#) + (if (eq? #{p 4245}# '_) '() - (if (#{syntax-object?\ 342}# #{e\ 4244}#) - (#{match*\ 4066}# - (#{syntax-object-expression\ 344}# #{e\ 4244}#) - #{p\ 4245}# - (#{syntax-object-wrap\ 346}# #{e\ 4244}#) + (if (#{syntax-object? 342}# #{e 4244}#) + (#{match* 4066}# + (#{syntax-object-expression 344}# #{e 4244}#) + #{p 4245}# + (#{syntax-object-wrap 346}# #{e 4244}#) '() - (#{syntax-object-module\ 348}# #{e\ 4244}#)) - (#{match*\ 4066}# - #{e\ 4244}# - #{p\ 4245}# + (#{syntax-object-module 348}# #{e 4244}#)) + (#{match* 4066}# + #{e 4244}# + #{p 4245}# '(()) '() #f))))))))))))) @@ -14399,15 +14319,15 @@ (make-syntax-transformer 'with-syntax 'macro - (lambda (#{x\ 4256}#) - (let ((#{tmp\ 4258}# #{x\ 4256}#)) - (let ((#{tmp\ 4259}# + (lambda (#{x 4256}#) + (let ((#{tmp 4258}# #{x 4256}#)) + (let ((#{tmp 4259}# ($sc-dispatch - #{tmp\ 4258}# + #{tmp 4258}# '(_ () any . each-any)))) - (if #{tmp\ 4259}# + (if #{tmp 4259}# (@apply - (lambda (#{e1\ 4262}# #{e2\ 4263}#) + (lambda (#{e1 4262}# #{e2 4263}#) (cons '#(syntax-object let ((top) @@ -14418,18 +14338,18 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) - (cons '() (cons #{e1\ 4262}# #{e2\ 4263}#)))) - #{tmp\ 4259}#) - (let ((#{tmp\ 4265}# + (cons '() (cons #{e1 4262}# #{e2 4263}#)))) + #{tmp 4259}#) + (let ((#{tmp 4265}# ($sc-dispatch - #{tmp\ 4258}# + #{tmp 4258}# '(_ ((any any)) any . each-any)))) - (if #{tmp\ 4265}# + (if #{tmp 4265}# (@apply - (lambda (#{out\ 4270}# - #{in\ 4271}# - #{e1\ 4272}# - #{e2\ 4273}#) + (lambda (#{out 4270}# + #{in 4271}# + #{e1 4272}# + #{e2 4273}#) (list '#(syntax-object syntax-case ((top) @@ -14440,9 +14360,9 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) - #{in\ 4271}# + #{in 4271}# '() - (list #{out\ 4270}# + (list #{out 4270}# (cons '#(syntax-object let ((top) @@ -14454,19 +14374,18 @@ #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) (cons '() - (cons #{e1\ 4272}# - #{e2\ 4273}#)))))) - #{tmp\ 4265}#) - (let ((#{tmp\ 4275}# + (cons #{e1 4272}# #{e2 4273}#)))))) + #{tmp 4265}#) + (let ((#{tmp 4275}# ($sc-dispatch - #{tmp\ 4258}# + #{tmp 4258}# '(_ #(each (any any)) any . each-any)))) - (if #{tmp\ 4275}# + (if #{tmp 4275}# (@apply - (lambda (#{out\ 4280}# - #{in\ 4281}# - #{e1\ 4282}# - #{e2\ 4283}#) + (lambda (#{out 4280}# + #{in 4281}# + #{e1 4282}# + #{e2 4283}#) (list '#(syntax-object syntax-case ((top) @@ -14487,9 +14406,9 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4257"))) (hygiene guile)) - #{in\ 4281}#) + #{in 4281}#) '() - (list #{out\ 4280}# + (list #{out 4280}# (cons '#(syntax-object let ((top) @@ -14507,30 +14426,30 @@ #("i4257"))) (hygiene guile)) (cons '() - (cons #{e1\ 4282}# - #{e2\ 4283}#)))))) - #{tmp\ 4275}#) + (cons #{e1 4282}# + #{e2 4283}#)))))) + #{tmp 4275}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4258}#))))))))))) + #{tmp 4258}#))))))))))) (define syntax-rules (make-syntax-transformer 'syntax-rules 'macro - (lambda (#{x\ 4287}#) - (let ((#{tmp\ 4289}# #{x\ 4287}#)) - (let ((#{tmp\ 4290}# + (lambda (#{x 4287}#) + (let ((#{tmp 4289}# #{x 4287}#)) + (let ((#{tmp 4290}# ($sc-dispatch - #{tmp\ 4289}# + #{tmp 4289}# '(_ each-any . #(each ((any . any) any)))))) - (if #{tmp\ 4290}# + (if #{tmp 4290}# (@apply - (lambda (#{k\ 4295}# - #{keyword\ 4296}# - #{pattern\ 4297}# - #{template\ 4298}#) + (lambda (#{k 4295}# + #{keyword 4296}# + #{pattern 4297}# + #{template 4298}#) (list '#(syntax-object lambda ((top) @@ -14583,7 +14502,7 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - #{pattern\ 4297}#)) + #{pattern 4297}#)) (cons '#(syntax-object syntax-case ((top) @@ -14604,9 +14523,9 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - (cons #{k\ 4295}# - (map (lambda (#{tmp\ 4302}# - #{tmp\ 4301}#) + (cons #{k 4295}# + (map (lambda (#{tmp 4302}# + #{tmp 4301}#) (list (cons '#(syntax-object dummy ((top) @@ -14632,7 +14551,7 @@ #((top)) #("i4288"))) (hygiene guile)) - #{tmp\ 4301}#) + #{tmp 4301}#) (list '#(syntax-object syntax ((top) @@ -14658,30 +14577,30 @@ #((top)) #("i4288"))) (hygiene guile)) - #{tmp\ 4302}#))) - #{template\ 4298}# - #{pattern\ 4297}#)))))) - #{tmp\ 4290}#) - (let ((#{tmp\ 4303}# + #{tmp 4302}#))) + #{template 4298}# + #{pattern 4297}#)))))) + #{tmp 4290}#) + (let ((#{tmp 4303}# ($sc-dispatch - #{tmp\ 4289}# + #{tmp 4289}# '(_ each-any any . #(each ((any . any) any)))))) - (if (if #{tmp\ 4303}# + (if (if #{tmp 4303}# (@apply - (lambda (#{k\ 4309}# - #{docstring\ 4310}# - #{keyword\ 4311}# - #{pattern\ 4312}# - #{template\ 4313}#) - (string? (syntax->datum #{docstring\ 4310}#))) - #{tmp\ 4303}#) + (lambda (#{k 4309}# + #{docstring 4310}# + #{keyword 4311}# + #{pattern 4312}# + #{template 4313}#) + (string? (syntax->datum #{docstring 4310}#))) + #{tmp 4303}#) #f) (@apply - (lambda (#{k\ 4319}# - #{docstring\ 4320}# - #{keyword\ 4321}# - #{pattern\ 4322}# - #{template\ 4323}#) + (lambda (#{k 4319}# + #{docstring 4320}# + #{keyword 4321}# + #{pattern 4322}# + #{template 4323}#) (list '#(syntax-object lambda ((top) @@ -14702,7 +14621,7 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile))) - #{docstring\ 4320}# + #{docstring 4320}# (vector '(#(syntax-object macro-type @@ -14739,7 +14658,7 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - #{pattern\ 4322}#)) + #{pattern 4322}#)) (cons '#(syntax-object syntax-case ((top) @@ -14772,9 +14691,9 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4288"))) (hygiene guile)) - (cons #{k\ 4319}# - (map (lambda (#{tmp\ 4327}# - #{tmp\ 4326}#) + (cons #{k 4319}# + (map (lambda (#{tmp 4327}# + #{tmp 4326}#) (list (cons '#(syntax-object dummy ((top) @@ -14804,7 +14723,7 @@ #("i4288"))) (hygiene guile)) - #{tmp\ 4326}#) + #{tmp 4326}#) (list '#(syntax-object syntax ((top) @@ -14834,45 +14753,45 @@ #("i4288"))) (hygiene guile)) - #{tmp\ 4327}#))) - #{template\ 4323}# - #{pattern\ 4322}#)))))) - #{tmp\ 4303}#) + #{tmp 4327}#))) + #{template 4323}# + #{pattern 4322}#)))))) + #{tmp 4303}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4289}#))))))))) + #{tmp 4289}#))))))))) (define let* (make-syntax-transformer 'let* 'macro - (lambda (#{x\ 4328}#) - (let ((#{tmp\ 4330}# #{x\ 4328}#)) - (let ((#{tmp\ 4331}# + (lambda (#{x 4328}#) + (let ((#{tmp 4330}# #{x 4328}#)) + (let ((#{tmp 4331}# ($sc-dispatch - #{tmp\ 4330}# + #{tmp 4330}# '(any #(each (any any)) any . each-any)))) - (if (if #{tmp\ 4331}# + (if (if #{tmp 4331}# (@apply - (lambda (#{let*\ 4337}# - #{x\ 4338}# - #{v\ 4339}# - #{e1\ 4340}# - #{e2\ 4341}#) - (and-map identifier? #{x\ 4338}#)) - #{tmp\ 4331}#) + (lambda (#{let* 4337}# + #{x 4338}# + #{v 4339}# + #{e1 4340}# + #{e2 4341}#) + (and-map identifier? #{x 4338}#)) + #{tmp 4331}#) #f) (@apply - (lambda (#{let*\ 4348}# - #{x\ 4349}# - #{v\ 4350}# - #{e1\ 4351}# - #{e2\ 4352}#) + (lambda (#{let* 4348}# + #{x 4349}# + #{v 4350}# + #{e1 4351}# + #{e2 4352}#) (letrec* - ((#{f\ 4355}# - (lambda (#{bindings\ 4356}#) - (if (null? #{bindings\ 4356}#) + ((#{f 4355}# + (lambda (#{bindings 4356}#) + (if (null? #{bindings 4356}#) (cons '#(syntax-object let ((top) @@ -14892,15 +14811,15 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4329"))) (hygiene guile)) - (cons '() (cons #{e1\ 4351}# #{e2\ 4352}#))) - (let ((#{tmp\ 4361}# - (list (#{f\ 4355}# (cdr #{bindings\ 4356}#)) - (car #{bindings\ 4356}#)))) - (let ((#{tmp\ 4362}# - ($sc-dispatch #{tmp\ 4361}# '(any any)))) - (if #{tmp\ 4362}# + (cons '() (cons #{e1 4351}# #{e2 4352}#))) + (let ((#{tmp 4361}# + (list (#{f 4355}# (cdr #{bindings 4356}#)) + (car #{bindings 4356}#)))) + (let ((#{tmp 4362}# + ($sc-dispatch #{tmp 4361}# '(any any)))) + (if #{tmp 4362}# (@apply - (lambda (#{body\ 4365}# #{binding\ 4366}#) + (lambda (#{body 4365}# #{binding 4366}#) (list '#(syntax-object let ((top) @@ -14928,76 +14847,76 @@ #((top)) #("i4329"))) (hygiene guile)) - (list #{binding\ 4366}#) - #{body\ 4365}#)) - #{tmp\ 4362}#) + (list #{binding 4366}#) + #{body 4365}#)) + #{tmp 4362}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4361}#)))))))) + #{tmp 4361}#)))))))) (begin - (#{f\ 4355}# (map list #{x\ 4349}# #{v\ 4350}#))))) - #{tmp\ 4331}#) + (#{f 4355}# (map list #{x 4349}# #{v 4350}#))))) + #{tmp 4331}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4330}#))))))) + #{tmp 4330}#))))))) (define do (make-syntax-transformer 'do 'macro - (lambda (#{orig-x\ 4367}#) - (let ((#{tmp\ 4369}# #{orig-x\ 4367}#)) - (let ((#{tmp\ 4370}# + (lambda (#{orig-x 4367}#) + (let ((#{tmp 4369}# #{orig-x 4367}#)) + (let ((#{tmp 4370}# ($sc-dispatch - #{tmp\ 4369}# + #{tmp 4369}# '(_ #(each (any any . any)) (any . each-any) . each-any)))) - (if #{tmp\ 4370}# + (if #{tmp 4370}# (@apply - (lambda (#{var\ 4377}# - #{init\ 4378}# - #{step\ 4379}# - #{e0\ 4380}# - #{e1\ 4381}# - #{c\ 4382}#) - (let ((#{tmp\ 4384}# - (map (lambda (#{v\ 4405}# #{s\ 4406}#) - (let ((#{tmp\ 4409}# #{s\ 4406}#)) - (let ((#{tmp\ 4410}# - ($sc-dispatch #{tmp\ 4409}# '()))) - (if #{tmp\ 4410}# + (lambda (#{var 4377}# + #{init 4378}# + #{step 4379}# + #{e0 4380}# + #{e1 4381}# + #{c 4382}#) + (let ((#{tmp 4384}# + (map (lambda (#{v 4405}# #{s 4406}#) + (let ((#{tmp 4409}# #{s 4406}#)) + (let ((#{tmp 4410}# + ($sc-dispatch #{tmp 4409}# '()))) + (if #{tmp 4410}# (@apply - (lambda () #{v\ 4405}#) - #{tmp\ 4410}#) - (let ((#{tmp\ 4411}# + (lambda () #{v 4405}#) + #{tmp 4410}#) + (let ((#{tmp 4411}# ($sc-dispatch - #{tmp\ 4409}# + #{tmp 4409}# '(any)))) - (if #{tmp\ 4411}# + (if #{tmp 4411}# (@apply - (lambda (#{e\ 4413}#) #{e\ 4413}#) - #{tmp\ 4411}#) - (let ((#{_\ 4415}# #{tmp\ 4409}#)) + (lambda (#{e 4413}#) #{e 4413}#) + #{tmp 4411}#) + (let ((#{_ 4415}# #{tmp 4409}#)) (syntax-violation 'do "bad step expression" - #{orig-x\ 4367}# - #{s\ 4406}#)))))))) - #{var\ 4377}# - #{step\ 4379}#))) - (let ((#{tmp\ 4385}# - ($sc-dispatch #{tmp\ 4384}# 'each-any))) - (if #{tmp\ 4385}# + #{orig-x 4367}# + #{s 4406}#)))))))) + #{var 4377}# + #{step 4379}#))) + (let ((#{tmp 4385}# + ($sc-dispatch #{tmp 4384}# 'each-any))) + (if #{tmp 4385}# (@apply - (lambda (#{step\ 4387}#) - (let ((#{tmp\ 4388}# #{e1\ 4381}#)) - (let ((#{tmp\ 4389}# - ($sc-dispatch #{tmp\ 4388}# '()))) - (if #{tmp\ 4389}# + (lambda (#{step 4387}#) + (let ((#{tmp 4388}# #{e1 4381}#)) + (let ((#{tmp 4389}# + ($sc-dispatch #{tmp 4388}# '()))) + (if #{tmp 4389}# (@apply (lambda () (list '#(syntax-object @@ -15056,9 +14975,7 @@ #((top)) #("i4368"))) (hygiene guile)) - (map list - #{var\ 4377}# - #{init\ 4378}#) + (map list #{var 4377}# #{init 4378}#) (list '#(syntax-object if ((top) @@ -15120,7 +15037,7 @@ #((top)) #("i4368"))) (hygiene guile)) - #{e0\ 4380}#) + #{e0 4380}#) (cons '#(syntax-object begin ((top) @@ -15155,7 +15072,7 @@ #("i4368"))) (hygiene guile)) (append - #{c\ 4382}# + #{c 4382}# (list (cons '#(syntax-object doloop ((top) @@ -15196,15 +15113,15 @@ #("i4368"))) (hygiene guile)) - #{step\ 4387}#))))))) - #{tmp\ 4389}#) - (let ((#{tmp\ 4394}# + #{step 4387}#))))))) + #{tmp 4389}#) + (let ((#{tmp 4394}# ($sc-dispatch - #{tmp\ 4388}# + #{tmp 4388}# '(any . each-any)))) - (if #{tmp\ 4394}# + (if #{tmp 4394}# (@apply - (lambda (#{e1\ 4397}# #{e2\ 4398}#) + (lambda (#{e1 4397}# #{e2 4398}#) (list '#(syntax-object let ((top) @@ -15270,8 +15187,8 @@ #("i4368"))) (hygiene guile)) (map list - #{var\ 4377}# - #{init\ 4378}#) + #{var 4377}# + #{init 4378}#) (list '#(syntax-object if ((top) @@ -15309,7 +15226,7 @@ #((top)) #("i4368"))) (hygiene guile)) - #{e0\ 4380}# + #{e0 4380}# (cons '#(syntax-object begin ((top) @@ -15354,8 +15271,8 @@ #((top)) #("i4368"))) (hygiene guile)) - (cons #{e1\ 4397}# - #{e2\ 4398}#)) + (cons #{e1 4397}# + #{e2 4398}#)) (cons '#(syntax-object begin ((top) @@ -15401,7 +15318,7 @@ #("i4368"))) (hygiene guile)) (append - #{c\ 4382}# + #{c 4382}# (list (cons '#(syntax-object doloop ((top) @@ -15449,34 +15366,34 @@ #("i4368"))) (hygiene guile)) - #{step\ 4387}#))))))) - #{tmp\ 4394}#) + #{step 4387}#))))))) + #{tmp 4394}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4388}#))))))) - #{tmp\ 4385}#) + #{tmp 4388}#))))))) + #{tmp 4385}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4384}#))))) - #{tmp\ 4370}#) + #{tmp 4384}#))))) + #{tmp 4370}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4369}#))))))) + #{tmp 4369}#))))))) (define quasiquote (make-syntax-transformer 'quasiquote 'macro (letrec* - ((#{quasi\ 4419}# - (lambda (#{p\ 4432}# #{lev\ 4433}#) - (let ((#{tmp\ 4436}# #{p\ 4432}#)) - (let ((#{tmp\ 4437}# + ((#{quasi 4419}# + (lambda (#{p 4432}# #{lev 4433}#) + (let ((#{tmp 4436}# #{p 4432}#)) + (let ((#{tmp 4437}# ($sc-dispatch - #{tmp\ 4436}# + #{tmp 4436}# '(#(free-id #(syntax-object unquote @@ -15503,10 +15420,10 @@ "i4418"))) (hygiene guile))) any)))) - (if #{tmp\ 4437}# + (if #{tmp 4437}# (@apply - (lambda (#{p\ 4439}#) - (if (= #{lev\ 4433}# 0) + (lambda (#{p 4439}#) + (if (= #{lev 4433}# 0) (list '#(syntax-object "value" ((top) @@ -15532,8 +15449,8 @@ "i4420" "i4418"))) (hygiene guile)) - #{p\ 4439}#) - (#{quasicons\ 4423}# + #{p 4439}#) + (#{quasicons 4423}# '(#(syntax-object "quote" ((top) @@ -15584,13 +15501,13 @@ "i4420" "i4418"))) (hygiene guile))) - (#{quasi\ 4419}# - (list #{p\ 4439}#) - (1- #{lev\ 4433}#))))) - #{tmp\ 4437}#) - (let ((#{tmp\ 4440}# + (#{quasi 4419}# + (list #{p 4439}#) + (#{1-}# #{lev 4433}#))))) + #{tmp 4437}#) + (let ((#{tmp 4440}# ($sc-dispatch - #{tmp\ 4436}# + #{tmp 4436}# '(#(free-id #(syntax-object quasiquote @@ -15617,10 +15534,10 @@ "i4418"))) (hygiene guile))) any)))) - (if #{tmp\ 4440}# + (if #{tmp 4440}# (@apply - (lambda (#{p\ 4442}#) - (#{quasicons\ 4423}# + (lambda (#{p 4442}#) + (#{quasicons 4423}# '(#(syntax-object "quote" ((top) @@ -15671,19 +15588,19 @@ "i4420" "i4418"))) (hygiene guile))) - (#{quasi\ 4419}# - (list #{p\ 4442}#) - (1+ #{lev\ 4433}#)))) - #{tmp\ 4440}#) - (let ((#{tmp\ 4443}# - ($sc-dispatch #{tmp\ 4436}# '(any . any)))) - (if #{tmp\ 4443}# + (#{quasi 4419}# + (list #{p 4442}#) + (#{1+}# #{lev 4433}#)))) + #{tmp 4440}#) + (let ((#{tmp 4443}# + ($sc-dispatch #{tmp 4436}# '(any . any)))) + (if #{tmp 4443}# (@apply - (lambda (#{p\ 4446}# #{q\ 4447}#) - (let ((#{tmp\ 4448}# #{p\ 4446}#)) - (let ((#{tmp\ 4449}# + (lambda (#{p 4446}# #{q 4447}#) + (let ((#{tmp 4448}# #{p 4446}#)) + (let ((#{tmp 4449}# ($sc-dispatch - #{tmp\ 4448}# + #{tmp 4448}# '(#(free-id #(syntax-object unquote @@ -15721,12 +15638,12 @@ (hygiene guile))) . each-any)))) - (if #{tmp\ 4449}# + (if #{tmp 4449}# (@apply - (lambda (#{p\ 4451}#) - (if (= #{lev\ 4433}# 0) - (#{quasilist*\ 4427}# - (map (lambda (#{tmp\ 4452}#) + (lambda (#{p 4451}#) + (if (= #{lev 4433}# 0) + (#{quasilist* 4427}# + (map (lambda (#{tmp 4452}#) (list '#(syntax-object "value" ((top) @@ -15767,13 +15684,13 @@ "i4420" "i4418"))) (hygiene guile)) - #{tmp\ 4452}#)) - #{p\ 4451}#) - (#{quasi\ 4419}# - #{q\ 4447}# - #{lev\ 4433}#)) - (#{quasicons\ 4423}# - (#{quasicons\ 4423}# + #{tmp 4452}#)) + #{p 4451}#) + (#{quasi 4419}# + #{q 4447}# + #{lev 4433}#)) + (#{quasicons 4423}# + (#{quasicons 4423}# '(#(syntax-object "quote" ((top) @@ -15850,16 +15767,16 @@ "i4420" "i4418"))) (hygiene guile))) - (#{quasi\ 4419}# - #{p\ 4451}# - (1- #{lev\ 4433}#))) - (#{quasi\ 4419}# - #{q\ 4447}# - #{lev\ 4433}#)))) - #{tmp\ 4449}#) - (let ((#{tmp\ 4454}# + (#{quasi 4419}# + #{p 4451}# + (#{1-}# #{lev 4433}#))) + (#{quasi 4419}# + #{q 4447}# + #{lev 4433}#)))) + #{tmp 4449}#) + (let ((#{tmp 4454}# ($sc-dispatch - #{tmp\ 4448}# + #{tmp 4448}# '(#(free-id #(syntax-object unquote-splicing @@ -15897,12 +15814,12 @@ (hygiene guile))) . each-any)))) - (if #{tmp\ 4454}# + (if #{tmp 4454}# (@apply - (lambda (#{p\ 4456}#) - (if (= #{lev\ 4433}# 0) - (#{quasiappend\ 4425}# - (map (lambda (#{tmp\ 4457}#) + (lambda (#{p 4456}#) + (if (= #{lev 4433}# 0) + (#{quasiappend 4425}# + (map (lambda (#{tmp 4457}#) (list '#(syntax-object "value" ((top) @@ -15948,13 +15865,13 @@ "i4420" "i4418"))) (hygiene guile)) - #{tmp\ 4457}#)) - #{p\ 4456}#) - (#{quasi\ 4419}# - #{q\ 4447}# - #{lev\ 4433}#)) - (#{quasicons\ 4423}# - (#{quasicons\ 4423}# + #{tmp 4457}#)) + #{p 4456}#) + (#{quasi 4419}# + #{q 4447}# + #{lev 4433}#)) + (#{quasicons 4423}# + (#{quasicons 4423}# '(#(syntax-object "quote" ((top) @@ -16031,35 +15948,33 @@ "i4420" "i4418"))) (hygiene guile))) - (#{quasi\ 4419}# - #{p\ 4456}# - (1- #{lev\ 4433}#))) - (#{quasi\ 4419}# - #{q\ 4447}# - #{lev\ 4433}#)))) - #{tmp\ 4454}#) - (let ((#{_\ 4460}# #{tmp\ 4448}#)) - (#{quasicons\ 4423}# - (#{quasi\ 4419}# - #{p\ 4446}# - #{lev\ 4433}#) - (#{quasi\ 4419}# - #{q\ 4447}# - #{lev\ 4433}#))))))))) - #{tmp\ 4443}#) - (let ((#{tmp\ 4461}# + (#{quasi 4419}# + #{p 4456}# + (#{1-}# #{lev 4433}#))) + (#{quasi 4419}# + #{q 4447}# + #{lev 4433}#)))) + #{tmp 4454}#) + (let ((#{_ 4460}# #{tmp 4448}#)) + (#{quasicons 4423}# + (#{quasi 4419}# + #{p 4446}# + #{lev 4433}#) + (#{quasi 4419}# + #{q 4447}# + #{lev 4433}#))))))))) + #{tmp 4443}#) + (let ((#{tmp 4461}# ($sc-dispatch - #{tmp\ 4436}# + #{tmp 4436}# '#(vector each-any)))) - (if #{tmp\ 4461}# + (if #{tmp 4461}# (@apply - (lambda (#{x\ 4463}#) - (#{quasivector\ 4429}# - (#{vquasi\ 4421}# - #{x\ 4463}# - #{lev\ 4433}#))) - #{tmp\ 4461}#) - (let ((#{p\ 4466}# #{tmp\ 4436}#)) + (lambda (#{x 4463}#) + (#{quasivector 4429}# + (#{vquasi 4421}# #{x 4463}# #{lev 4433}#))) + #{tmp 4461}#) + (let ((#{p 4466}# #{tmp 4436}#)) (list '#(syntax-object "quote" ((top) @@ -16091,19 +16006,19 @@ "i4420" "i4418"))) (hygiene guile)) - #{p\ 4466}#))))))))))))) - (#{vquasi\ 4421}# - (lambda (#{p\ 4467}# #{lev\ 4468}#) - (let ((#{tmp\ 4471}# #{p\ 4467}#)) - (let ((#{tmp\ 4472}# - ($sc-dispatch #{tmp\ 4471}# '(any . any)))) - (if #{tmp\ 4472}# + #{p 4466}#))))))))))))) + (#{vquasi 4421}# + (lambda (#{p 4467}# #{lev 4468}#) + (let ((#{tmp 4471}# #{p 4467}#)) + (let ((#{tmp 4472}# + ($sc-dispatch #{tmp 4471}# '(any . any)))) + (if #{tmp 4472}# (@apply - (lambda (#{p\ 4475}# #{q\ 4476}#) - (let ((#{tmp\ 4477}# #{p\ 4475}#)) - (let ((#{tmp\ 4478}# + (lambda (#{p 4475}# #{q 4476}#) + (let ((#{tmp 4477}# #{p 4475}#)) + (let ((#{tmp 4478}# ($sc-dispatch - #{tmp\ 4477}# + #{tmp 4477}# '(#(free-id #(syntax-object unquote @@ -16141,12 +16056,12 @@ (hygiene guile))) . each-any)))) - (if #{tmp\ 4478}# + (if #{tmp 4478}# (@apply - (lambda (#{p\ 4480}#) - (if (= #{lev\ 4468}# 0) - (#{quasilist*\ 4427}# - (map (lambda (#{tmp\ 4481}#) + (lambda (#{p 4480}#) + (if (= #{lev 4468}# 0) + (#{quasilist* 4427}# + (map (lambda (#{tmp 4481}#) (list '#(syntax-object "value" ((top) @@ -16185,13 +16100,11 @@ "i4420" "i4418"))) (hygiene guile)) - #{tmp\ 4481}#)) - #{p\ 4480}#) - (#{vquasi\ 4421}# - #{q\ 4476}# - #{lev\ 4468}#)) - (#{quasicons\ 4423}# - (#{quasicons\ 4423}# + #{tmp 4481}#)) + #{p 4480}#) + (#{vquasi 4421}# #{q 4476}# #{lev 4468}#)) + (#{quasicons 4423}# + (#{quasicons 4423}# '(#(syntax-object "quote" ((top) @@ -16262,16 +16175,14 @@ "i4420" "i4418"))) (hygiene guile))) - (#{quasi\ 4419}# - #{p\ 4480}# - (1- #{lev\ 4468}#))) - (#{vquasi\ 4421}# - #{q\ 4476}# - #{lev\ 4468}#)))) - #{tmp\ 4478}#) - (let ((#{tmp\ 4483}# + (#{quasi 4419}# + #{p 4480}# + (#{1-}# #{lev 4468}#))) + (#{vquasi 4421}# #{q 4476}# #{lev 4468}#)))) + #{tmp 4478}#) + (let ((#{tmp 4483}# ($sc-dispatch - #{tmp\ 4477}# + #{tmp 4477}# '(#(free-id #(syntax-object unquote-splicing @@ -16309,12 +16220,12 @@ (hygiene guile))) . each-any)))) - (if #{tmp\ 4483}# + (if #{tmp 4483}# (@apply - (lambda (#{p\ 4485}#) - (if (= #{lev\ 4468}# 0) - (#{quasiappend\ 4425}# - (map (lambda (#{tmp\ 4486}#) + (lambda (#{p 4485}#) + (if (= #{lev 4468}# 0) + (#{quasiappend 4425}# + (map (lambda (#{tmp 4486}#) (list '#(syntax-object "value" ((top) @@ -16353,13 +16264,13 @@ "i4420" "i4418"))) (hygiene guile)) - #{tmp\ 4486}#)) - #{p\ 4485}#) - (#{vquasi\ 4421}# - #{q\ 4476}# - #{lev\ 4468}#)) - (#{quasicons\ 4423}# - (#{quasicons\ 4423}# + #{tmp 4486}#)) + #{p 4485}#) + (#{vquasi 4421}# + #{q 4476}# + #{lev 4468}#)) + (#{quasicons 4423}# + (#{quasicons 4423}# '(#(syntax-object "quote" ((top) @@ -16436,22 +16347,22 @@ "i4420" "i4418"))) (hygiene guile))) - (#{quasi\ 4419}# - #{p\ 4485}# - (1- #{lev\ 4468}#))) - (#{vquasi\ 4421}# - #{q\ 4476}# - #{lev\ 4468}#)))) - #{tmp\ 4483}#) - (let ((#{_\ 4489}# #{tmp\ 4477}#)) - (#{quasicons\ 4423}# - (#{quasi\ 4419}# #{p\ 4475}# #{lev\ 4468}#) - (#{vquasi\ 4421}# - #{q\ 4476}# - #{lev\ 4468}#))))))))) - #{tmp\ 4472}#) - (let ((#{tmp\ 4490}# ($sc-dispatch #{tmp\ 4471}# '()))) - (if #{tmp\ 4490}# + (#{quasi 4419}# + #{p 4485}# + (#{1-}# #{lev 4468}#))) + (#{vquasi 4421}# + #{q 4476}# + #{lev 4468}#)))) + #{tmp 4483}#) + (let ((#{_ 4489}# #{tmp 4477}#)) + (#{quasicons 4423}# + (#{quasi 4419}# #{p 4475}# #{lev 4468}#) + (#{vquasi 4421}# + #{q 4476}# + #{lev 4468}#))))))))) + #{tmp 4472}#) + (let ((#{tmp 4490}# ($sc-dispatch #{tmp 4471}# '()))) + (if #{tmp 4490}# (@apply (lambda () '(#(syntax-object @@ -16479,35 +16390,35 @@ "i4418"))) (hygiene guile)) ())) - #{tmp\ 4490}#) + #{tmp 4490}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4471}#)))))))) - (#{quasicons\ 4423}# - (lambda (#{x\ 4491}# #{y\ 4492}#) - (let ((#{tmp\ 4496}# (list #{x\ 4491}# #{y\ 4492}#))) - (let ((#{tmp\ 4497}# - ($sc-dispatch #{tmp\ 4496}# '(any any)))) - (if #{tmp\ 4497}# + #{tmp 4471}#)))))))) + (#{quasicons 4423}# + (lambda (#{x 4491}# #{y 4492}#) + (let ((#{tmp 4496}# (list #{x 4491}# #{y 4492}#))) + (let ((#{tmp 4497}# + ($sc-dispatch #{tmp 4496}# '(any any)))) + (if #{tmp 4497}# (@apply - (lambda (#{x\ 4500}# #{y\ 4501}#) - (let ((#{tmp\ 4502}# #{y\ 4501}#)) - (let ((#{tmp\ 4503}# + (lambda (#{x 4500}# #{y 4501}#) + (let ((#{tmp 4502}# #{y 4501}#)) + (let ((#{tmp 4503}# ($sc-dispatch - #{tmp\ 4502}# + #{tmp 4502}# '(#(atom "quote") any)))) - (if #{tmp\ 4503}# + (if #{tmp 4503}# (@apply - (lambda (#{dy\ 4505}#) - (let ((#{tmp\ 4506}# #{x\ 4500}#)) - (let ((#{tmp\ 4507}# + (lambda (#{dy 4505}#) + (let ((#{tmp 4506}# #{x 4500}#)) + (let ((#{tmp 4507}# ($sc-dispatch - #{tmp\ 4506}# + #{tmp 4506}# '(#(atom "quote") any)))) - (if #{tmp\ 4507}# + (if #{tmp 4507}# (@apply - (lambda (#{dx\ 4509}#) + (lambda (#{dx 4509}#) (list '#(syntax-object "quote" ((top) @@ -16552,11 +16463,10 @@ "i4420" "i4418"))) (hygiene guile)) - (cons #{dx\ 4509}# - #{dy\ 4505}#))) - #{tmp\ 4507}#) - (let ((#{_\ 4511}# #{tmp\ 4506}#)) - (if (null? #{dy\ 4505}#) + (cons #{dx 4509}# #{dy 4505}#))) + #{tmp 4507}#) + (let ((#{_ 4511}# #{tmp 4506}#)) + (if (null? #{dy 4505}#) (list '#(syntax-object "list" ((top) @@ -16601,7 +16511,7 @@ "i4420" "i4418"))) (hygiene guile)) - #{x\ 4500}#) + #{x 4500}#) (list '#(syntax-object "list*" ((top) @@ -16646,16 +16556,16 @@ "i4420" "i4418"))) (hygiene guile)) - #{x\ 4500}# - #{y\ 4501}#))))))) - #{tmp\ 4503}#) - (let ((#{tmp\ 4512}# + #{x 4500}# + #{y 4501}#))))))) + #{tmp 4503}#) + (let ((#{tmp 4512}# ($sc-dispatch - #{tmp\ 4502}# + #{tmp 4502}# '(#(atom "list") . any)))) - (if #{tmp\ 4512}# + (if #{tmp 4512}# (@apply - (lambda (#{stuff\ 4514}#) + (lambda (#{stuff 4514}#) (cons '#(syntax-object "list" ((top) @@ -16696,15 +16606,15 @@ "i4420" "i4418"))) (hygiene guile)) - (cons #{x\ 4500}# #{stuff\ 4514}#))) - #{tmp\ 4512}#) - (let ((#{tmp\ 4515}# + (cons #{x 4500}# #{stuff 4514}#))) + #{tmp 4512}#) + (let ((#{tmp 4515}# ($sc-dispatch - #{tmp\ 4502}# + #{tmp 4502}# '(#(atom "list*") . any)))) - (if #{tmp\ 4515}# + (if #{tmp 4515}# (@apply - (lambda (#{stuff\ 4517}#) + (lambda (#{stuff 4517}#) (cons '#(syntax-object "list*" ((top) @@ -16745,10 +16655,9 @@ "i4420" "i4418"))) (hygiene guile)) - (cons #{x\ 4500}# - #{stuff\ 4517}#))) - #{tmp\ 4515}#) - (let ((#{_\ 4519}# #{tmp\ 4502}#)) + (cons #{x 4500}# #{stuff 4517}#))) + #{tmp 4515}#) + (let ((#{_ 4519}# #{tmp 4502}#)) (list '#(syntax-object "list*" ((top) @@ -16789,24 +16698,22 @@ "i4420" "i4418"))) (hygiene guile)) - #{x\ 4500}# - #{y\ 4501}#)))))))))) - #{tmp\ 4497}#) + #{x 4500}# + #{y 4501}#)))))))))) + #{tmp 4497}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4496}#)))))) - (#{quasiappend\ 4425}# - (lambda (#{x\ 4520}# #{y\ 4521}#) - (let ((#{tmp\ 4524}# #{y\ 4521}#)) - (let ((#{tmp\ 4525}# - ($sc-dispatch - #{tmp\ 4524}# - '(#(atom "quote") ())))) - (if #{tmp\ 4525}# + #{tmp 4496}#)))))) + (#{quasiappend 4425}# + (lambda (#{x 4520}# #{y 4521}#) + (let ((#{tmp 4524}# #{y 4521}#)) + (let ((#{tmp 4525}# + ($sc-dispatch #{tmp 4524}# '(#(atom "quote") ())))) + (if #{tmp 4525}# (@apply (lambda () - (if (null? #{x\ 4520}#) + (if (null? #{x 4520}#) '(#(syntax-object "quote" ((top) @@ -16832,14 +16739,14 @@ "i4418"))) (hygiene guile)) ()) - (if (null? (cdr #{x\ 4520}#)) - (car #{x\ 4520}#) - (let ((#{tmp\ 4532}# #{x\ 4520}#)) - (let ((#{tmp\ 4533}# - ($sc-dispatch #{tmp\ 4532}# 'each-any))) - (if #{tmp\ 4533}# + (if (null? (cdr #{x 4520}#)) + (car #{x 4520}#) + (let ((#{tmp 4532}# #{x 4520}#)) + (let ((#{tmp 4533}# + ($sc-dispatch #{tmp 4532}# 'each-any))) + (if #{tmp 4533}# (@apply - (lambda (#{p\ 4535}#) + (lambda (#{p 4535}#) (cons '#(syntax-object "append" ((top) @@ -16875,22 +16782,22 @@ "i4420" "i4418"))) (hygiene guile)) - #{p\ 4535}#)) - #{tmp\ 4533}#) + #{p 4535}#)) + #{tmp 4533}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4532}#))))))) - #{tmp\ 4525}#) - (let ((#{_\ 4538}# #{tmp\ 4524}#)) - (if (null? #{x\ 4520}#) - #{y\ 4521}# - (let ((#{tmp\ 4543}# (list #{x\ 4520}# #{y\ 4521}#))) - (let ((#{tmp\ 4544}# - ($sc-dispatch #{tmp\ 4543}# '(each-any any)))) - (if #{tmp\ 4544}# + #{tmp 4532}#))))))) + #{tmp 4525}#) + (let ((#{_ 4538}# #{tmp 4524}#)) + (if (null? #{x 4520}#) + #{y 4521}# + (let ((#{tmp 4543}# (list #{x 4520}# #{y 4521}#))) + (let ((#{tmp 4544}# + ($sc-dispatch #{tmp 4543}# '(each-any any)))) + (if #{tmp 4544}# (@apply - (lambda (#{p\ 4547}# #{y\ 4548}#) + (lambda (#{p 4547}# #{y 4548}#) (cons '#(syntax-object "append" ((top) @@ -16927,33 +16834,33 @@ "i4420" "i4418"))) (hygiene guile)) - (append #{p\ 4547}# (list #{y\ 4548}#)))) - #{tmp\ 4544}#) + (append #{p 4547}# (list #{y 4548}#)))) + #{tmp 4544}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4543}#))))))))))) - (#{quasilist*\ 4427}# - (lambda (#{x\ 4550}# #{y\ 4551}#) + #{tmp 4543}#))))))))))) + (#{quasilist* 4427}# + (lambda (#{x 4550}# #{y 4551}#) (letrec* - ((#{f\ 4556}# - (lambda (#{x\ 4557}#) - (if (null? #{x\ 4557}#) - #{y\ 4551}# - (#{quasicons\ 4423}# - (car #{x\ 4557}#) - (#{f\ 4556}# (cdr #{x\ 4557}#))))))) - (begin (#{f\ 4556}# #{x\ 4550}#))))) - (#{quasivector\ 4429}# - (lambda (#{x\ 4558}#) - (let ((#{tmp\ 4560}# #{x\ 4558}#)) - (let ((#{tmp\ 4561}# + ((#{f 4556}# + (lambda (#{x 4557}#) + (if (null? #{x 4557}#) + #{y 4551}# + (#{quasicons 4423}# + (car #{x 4557}#) + (#{f 4556}# (cdr #{x 4557}#))))))) + (begin (#{f 4556}# #{x 4550}#))))) + (#{quasivector 4429}# + (lambda (#{x 4558}#) + (let ((#{tmp 4560}# #{x 4558}#)) + (let ((#{tmp 4561}# ($sc-dispatch - #{tmp\ 4560}# + #{tmp 4560}# '(#(atom "quote") each-any)))) - (if #{tmp\ 4561}# + (if #{tmp 4561}# (@apply - (lambda (#{x\ 4563}#) + (lambda (#{x 4563}#) (list '#(syntax-object "quote" ((top) @@ -16976,22 +16883,22 @@ "i4420" "i4418"))) (hygiene guile)) - (list->vector #{x\ 4563}#))) - #{tmp\ 4561}#) - (let ((#{_\ 4566}# #{tmp\ 4560}#)) + (list->vector #{x 4563}#))) + #{tmp 4561}#) + (let ((#{_ 4566}# #{tmp 4560}#)) (letrec* - ((#{f\ 4570}# - (lambda (#{y\ 4571}# #{k\ 4572}#) - (let ((#{tmp\ 4583}# #{y\ 4571}#)) - (let ((#{tmp\ 4584}# + ((#{f 4570}# + (lambda (#{y 4571}# #{k 4572}#) + (let ((#{tmp 4583}# #{y 4571}#)) + (let ((#{tmp 4584}# ($sc-dispatch - #{tmp\ 4583}# + #{tmp 4583}# '(#(atom "quote") each-any)))) - (if #{tmp\ 4584}# + (if #{tmp 4584}# (@apply - (lambda (#{y\ 4586}#) - (#{k\ 4572}# - (map (lambda (#{tmp\ 4587}#) + (lambda (#{y 4586}#) + (#{k 4572}# + (map (lambda (#{tmp 4587}#) (list '#(syntax-object "quote" ((top) @@ -17037,45 +16944,45 @@ "i4420" "i4418"))) (hygiene guile)) - #{tmp\ 4587}#)) - #{y\ 4586}#))) - #{tmp\ 4584}#) - (let ((#{tmp\ 4588}# + #{tmp 4587}#)) + #{y 4586}#))) + #{tmp 4584}#) + (let ((#{tmp 4588}# ($sc-dispatch - #{tmp\ 4583}# + #{tmp 4583}# '(#(atom "list") . each-any)))) - (if #{tmp\ 4588}# + (if #{tmp 4588}# (@apply - (lambda (#{y\ 4590}#) - (#{k\ 4572}# #{y\ 4590}#)) - #{tmp\ 4588}#) - (let ((#{tmp\ 4592}# + (lambda (#{y 4590}#) + (#{k 4572}# #{y 4590}#)) + #{tmp 4588}#) + (let ((#{tmp 4592}# ($sc-dispatch - #{tmp\ 4583}# + #{tmp 4583}# '(#(atom "list*") . #(each+ any (any) ()))))) - (if #{tmp\ 4592}# + (if #{tmp 4592}# (@apply - (lambda (#{y\ 4595}# #{z\ 4596}#) - (#{f\ 4570}# - #{z\ 4596}# - (lambda (#{ls\ 4597}#) - (#{k\ 4572}# + (lambda (#{y 4595}# #{z 4596}#) + (#{f 4570}# + #{z 4596}# + (lambda (#{ls 4597}#) + (#{k 4572}# (append - #{y\ 4595}# - #{ls\ 4597}#))))) - #{tmp\ 4592}#) - (let ((#{else\ 4601}# #{tmp\ 4583}#)) - (let ((#{tmp\ 4605}# #{x\ 4558}#)) - (let ((#{\ g4602\ 4607}# - #{tmp\ 4605}#)) + #{y 4595}# + #{ls 4597}#))))) + #{tmp 4592}#) + (let ((#{else 4601}# #{tmp 4583}#)) + (let ((#{tmp 4605}# #{x 4558}#)) + (let ((#{ g4602 4607}# + #{tmp 4605}#)) (list '#(syntax-object "list->vector" ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4602}#) + #(#{ g4602}#) #((m4603 top)) #("i4606")) #(ribcage @@ -17120,23 +17027,23 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4602\ 4607}#)))))))))))))) + #{ g4602 4607}#)))))))))))))) (begin - (#{f\ 4570}# - #{x\ 4558}# - (lambda (#{ls\ 4573}#) - (let ((#{tmp\ 4578}# #{ls\ 4573}#)) - (let ((#{tmp\ 4579}# - ($sc-dispatch #{tmp\ 4578}# 'each-any))) - (if #{tmp\ 4579}# + (#{f 4570}# + #{x 4558}# + (lambda (#{ls 4573}#) + (let ((#{tmp 4578}# #{ls 4573}#)) + (let ((#{tmp 4579}# + ($sc-dispatch #{tmp 4578}# 'each-any))) + (if #{tmp 4579}# (@apply - (lambda (#{\ g4575\ 4581}#) + (lambda (#{ g4575 4581}#) (cons '#(syntax-object "vector" ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4575}#) + #(#{ g4575}#) #((m4576 top)) #("i4580")) #(ribcage () () ()) @@ -17177,22 +17084,22 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4575\ 4581}#)) - #{tmp\ 4579}#) + #{ g4575 4581}#)) + #{tmp 4579}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4578}#)))))))))))))) - (#{emit\ 4431}# - (lambda (#{x\ 4608}#) - (let ((#{tmp\ 4610}# #{x\ 4608}#)) - (let ((#{tmp\ 4611}# + #{tmp 4578}#)))))))))))))) + (#{emit 4431}# + (lambda (#{x 4608}#) + (let ((#{tmp 4610}# #{x 4608}#)) + (let ((#{tmp 4611}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "quote") any)))) - (if #{tmp\ 4611}# + (if #{tmp 4611}# (@apply - (lambda (#{x\ 4613}#) + (lambda (#{x 4613}#) (list '#(syntax-object quote ((top) @@ -17215,28 +17122,27 @@ "i4420" "i4418"))) (hygiene guile)) - #{x\ 4613}#)) - #{tmp\ 4611}#) - (let ((#{tmp\ 4614}# + #{x 4613}#)) + #{tmp 4611}#) + (let ((#{tmp 4614}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "list") . each-any)))) - (if #{tmp\ 4614}# + (if #{tmp 4614}# (@apply - (lambda (#{x\ 4616}#) - (let ((#{tmp\ 4620}# - (map #{emit\ 4431}# #{x\ 4616}#))) - (let ((#{tmp\ 4621}# - ($sc-dispatch #{tmp\ 4620}# 'each-any))) - (if #{tmp\ 4621}# + (lambda (#{x 4616}#) + (let ((#{tmp 4620}# (map #{emit 4431}# #{x 4616}#))) + (let ((#{tmp 4621}# + ($sc-dispatch #{tmp 4620}# 'each-any))) + (if #{tmp 4621}# (@apply - (lambda (#{\ g4617\ 4623}#) + (lambda (#{ g4617 4623}#) (cons '#(syntax-object list ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4617}#) + #(#{ g4617}#) #((m4618 top)) #("i4622")) #(ribcage @@ -17270,45 +17176,45 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4617\ 4623}#)) - #{tmp\ 4621}#) + #{ g4617 4623}#)) + #{tmp 4621}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4620}#))))) - #{tmp\ 4614}#) - (let ((#{tmp\ 4626}# + #{tmp 4620}#))))) + #{tmp 4614}#) + (let ((#{tmp 4626}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "list*") . #(each+ any (any) ()))))) - (if #{tmp\ 4626}# + (if #{tmp 4626}# (@apply - (lambda (#{x\ 4629}# #{y\ 4630}#) + (lambda (#{x 4629}# #{y 4630}#) (letrec* - ((#{f\ 4633}# - (lambda (#{x*\ 4634}#) - (if (null? #{x*\ 4634}#) - (#{emit\ 4431}# #{y\ 4630}#) - (let ((#{tmp\ 4640}# - (list (#{emit\ 4431}# - (car #{x*\ 4634}#)) - (#{f\ 4633}# - (cdr #{x*\ 4634}#))))) - (let ((#{tmp\ 4641}# + ((#{f 4633}# + (lambda (#{x* 4634}#) + (if (null? #{x* 4634}#) + (#{emit 4431}# #{y 4630}#) + (let ((#{tmp 4640}# + (list (#{emit 4431}# + (car #{x* 4634}#)) + (#{f 4633}# + (cdr #{x* 4634}#))))) + (let ((#{tmp 4641}# ($sc-dispatch - #{tmp\ 4640}# + #{tmp 4640}# '(any any)))) - (if #{tmp\ 4641}# + (if #{tmp 4641}# (@apply - (lambda (#{\ g4637\ 4644}# - #{\ g4636\ 4645}#) + (lambda (#{ g4637 4644}# + #{ g4636 4645}#) (list '#(syntax-object cons ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4637}# - #{\ g4636}#) + #(#{ g4637}# + #{ g4636}#) #((m4638 top) (m4638 top)) #("i4642" "i4643")) @@ -17348,37 +17254,37 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4637\ 4644}# - #{\ g4636\ 4645}#)) - #{tmp\ 4641}#) + #{ g4637 4644}# + #{ g4636 4645}#)) + #{tmp 4641}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4640}#)))))))) - (begin (#{f\ 4633}# #{x\ 4629}#)))) - #{tmp\ 4626}#) - (let ((#{tmp\ 4646}# + #{tmp 4640}#)))))))) + (begin (#{f 4633}# #{x 4629}#)))) + #{tmp 4626}#) + (let ((#{tmp 4646}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "append") . each-any)))) - (if #{tmp\ 4646}# + (if #{tmp 4646}# (@apply - (lambda (#{x\ 4648}#) - (let ((#{tmp\ 4652}# - (map #{emit\ 4431}# #{x\ 4648}#))) - (let ((#{tmp\ 4653}# + (lambda (#{x 4648}#) + (let ((#{tmp 4652}# + (map #{emit 4431}# #{x 4648}#))) + (let ((#{tmp 4653}# ($sc-dispatch - #{tmp\ 4652}# + #{tmp 4652}# 'each-any))) - (if #{tmp\ 4653}# + (if #{tmp 4653}# (@apply - (lambda (#{\ g4649\ 4655}#) + (lambda (#{ g4649 4655}#) (cons '#(syntax-object append ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4649}#) + #(#{ g4649}#) #((m4650 top)) #("i4654")) #(ribcage @@ -17412,35 +17318,35 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4649\ 4655}#)) - #{tmp\ 4653}#) + #{ g4649 4655}#)) + #{tmp 4653}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4652}#))))) - #{tmp\ 4646}#) - (let ((#{tmp\ 4658}# + #{tmp 4652}#))))) + #{tmp 4646}#) + (let ((#{tmp 4658}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "vector") . each-any)))) - (if #{tmp\ 4658}# + (if #{tmp 4658}# (@apply - (lambda (#{x\ 4660}#) - (let ((#{tmp\ 4664}# - (map #{emit\ 4431}# #{x\ 4660}#))) - (let ((#{tmp\ 4665}# + (lambda (#{x 4660}#) + (let ((#{tmp 4664}# + (map #{emit 4431}# #{x 4660}#))) + (let ((#{tmp 4665}# ($sc-dispatch - #{tmp\ 4664}# + #{tmp 4664}# 'each-any))) - (if #{tmp\ 4665}# + (if #{tmp 4665}# (@apply - (lambda (#{\ g4661\ 4667}#) + (lambda (#{ g4661 4667}#) (cons '#(syntax-object vector ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4661}#) + #(#{ g4661}#) #((m4662 top)) #("i4666")) #(ribcage @@ -17474,30 +17380,30 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4661\ 4667}#)) - #{tmp\ 4665}#) + #{ g4661 4667}#)) + #{tmp 4665}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4664}#))))) - #{tmp\ 4658}#) - (let ((#{tmp\ 4670}# + #{tmp 4664}#))))) + #{tmp 4658}#) + (let ((#{tmp 4670}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "list->vector") any)))) - (if #{tmp\ 4670}# + (if #{tmp 4670}# (@apply - (lambda (#{x\ 4672}#) - (let ((#{tmp\ 4676}# - (#{emit\ 4431}# #{x\ 4672}#))) - (let ((#{\ g4673\ 4678}# - #{tmp\ 4676}#)) + (lambda (#{x 4672}#) + (let ((#{tmp 4676}# + (#{emit 4431}# #{x 4672}#))) + (let ((#{ g4673 4678}# + #{tmp 4676}#)) (list '#(syntax-object list->vector ((top) #(ribcage () () ()) #(ribcage - #(#{\ g4673}#) + #(#{ g4673}#) #((m4674 top)) #("i4677")) #(ribcage @@ -17531,75 +17437,75 @@ "i4420" "i4418"))) (hygiene guile)) - #{\ g4673\ 4678}#)))) - #{tmp\ 4670}#) - (let ((#{tmp\ 4679}# + #{ g4673 4678}#)))) + #{tmp 4670}#) + (let ((#{tmp 4679}# ($sc-dispatch - #{tmp\ 4610}# + #{tmp 4610}# '(#(atom "value") any)))) - (if #{tmp\ 4679}# + (if #{tmp 4679}# (@apply - (lambda (#{x\ 4681}#) #{x\ 4681}#) - #{tmp\ 4679}#) + (lambda (#{x 4681}#) #{x 4681}#) + #{tmp 4679}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4610}#))))))))))))))))))) + #{tmp 4610}#))))))))))))))))))) (begin - (lambda (#{x\ 4682}#) - (let ((#{tmp\ 4684}# #{x\ 4682}#)) - (let ((#{tmp\ 4685}# - ($sc-dispatch #{tmp\ 4684}# '(_ any)))) - (if #{tmp\ 4685}# + (lambda (#{x 4682}#) + (let ((#{tmp 4684}# #{x 4682}#)) + (let ((#{tmp 4685}# + ($sc-dispatch #{tmp 4684}# '(_ any)))) + (if #{tmp 4685}# (@apply - (lambda (#{e\ 4687}#) - (#{emit\ 4431}# (#{quasi\ 4419}# #{e\ 4687}# 0))) - #{tmp\ 4685}#) + (lambda (#{e 4687}#) + (#{emit 4431}# (#{quasi 4419}# #{e 4687}# 0))) + #{tmp 4685}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4684}#))))))))) + #{tmp 4684}#))))))))) (define include (make-syntax-transformer 'include 'macro - (lambda (#{x\ 4688}#) + (lambda (#{x 4688}#) (letrec* - ((#{read-file\ 4691}# - (lambda (#{fn\ 4692}# #{k\ 4693}#) + ((#{read-file 4691}# + (lambda (#{fn 4692}# #{k 4693}#) (begin - (let ((#{p\ 4697}# (open-input-file #{fn\ 4692}#))) + (let ((#{p 4697}# (open-input-file #{fn 4692}#))) (letrec* - ((#{f\ 4701}# - (lambda (#{x\ 4702}# #{result\ 4703}#) - (if (eof-object? #{x\ 4702}#) + ((#{f 4701}# + (lambda (#{x 4702}# #{result 4703}#) + (if (eof-object? #{x 4702}#) (begin - (close-input-port #{p\ 4697}#) - (reverse #{result\ 4703}#)) - (#{f\ 4701}# - (read #{p\ 4697}#) - (cons (datum->syntax #{k\ 4693}# #{x\ 4702}#) - #{result\ 4703}#)))))) - (begin (#{f\ 4701}# (read #{p\ 4697}#) '())))))))) + (close-input-port #{p 4697}#) + (reverse #{result 4703}#)) + (#{f 4701}# + (read #{p 4697}#) + (cons (datum->syntax #{k 4693}# #{x 4702}#) + #{result 4703}#)))))) + (begin (#{f 4701}# (read #{p 4697}#) '())))))))) (begin - (let ((#{tmp\ 4704}# #{x\ 4688}#)) - (let ((#{tmp\ 4705}# - ($sc-dispatch #{tmp\ 4704}# '(any any)))) - (if #{tmp\ 4705}# + (let ((#{tmp 4704}# #{x 4688}#)) + (let ((#{tmp 4705}# + ($sc-dispatch #{tmp 4704}# '(any any)))) + (if #{tmp 4705}# (@apply - (lambda (#{k\ 4708}# #{filename\ 4709}#) + (lambda (#{k 4708}# #{filename 4709}#) (begin - (let ((#{fn\ 4711}# (syntax->datum #{filename\ 4709}#))) - (let ((#{tmp\ 4713}# - (#{read-file\ 4691}# - #{fn\ 4711}# - #{filename\ 4709}#))) - (let ((#{tmp\ 4714}# - ($sc-dispatch #{tmp\ 4713}# 'each-any))) - (if #{tmp\ 4714}# + (let ((#{fn 4711}# (syntax->datum #{filename 4709}#))) + (let ((#{tmp 4713}# + (#{read-file 4691}# + #{fn 4711}# + #{filename 4709}#))) + (let ((#{tmp 4714}# + ($sc-dispatch #{tmp 4713}# 'each-any))) + (if #{tmp 4714}# (@apply - (lambda (#{exp\ 4716}#) + (lambda (#{exp 4716}#) (cons '#(syntax-object begin ((top) @@ -17627,45 +17533,45 @@ #((top)) #("i4689"))) (hygiene guile)) - #{exp\ 4716}#)) - #{tmp\ 4714}#) + #{exp 4716}#)) + #{tmp 4714}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4713}#))))))) - #{tmp\ 4705}#) + #{tmp 4713}#))))))) + #{tmp 4705}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4704}#))))))))) + #{tmp 4704}#))))))))) (define include-from-path (make-syntax-transformer 'include-from-path 'macro - (lambda (#{x\ 4718}#) - (let ((#{tmp\ 4720}# #{x\ 4718}#)) - (let ((#{tmp\ 4721}# - ($sc-dispatch #{tmp\ 4720}# '(any any)))) - (if #{tmp\ 4721}# + (lambda (#{x 4718}#) + (let ((#{tmp 4720}# #{x 4718}#)) + (let ((#{tmp 4721}# + ($sc-dispatch #{tmp 4720}# '(any any)))) + (if #{tmp 4721}# (@apply - (lambda (#{k\ 4724}# #{filename\ 4725}#) + (lambda (#{k 4724}# #{filename 4725}#) (begin - (let ((#{fn\ 4727}# (syntax->datum #{filename\ 4725}#))) - (let ((#{tmp\ 4729}# + (let ((#{fn 4727}# (syntax->datum #{filename 4725}#))) + (let ((#{tmp 4729}# (datum->syntax - #{filename\ 4725}# + #{filename 4725}# (begin - (let ((#{t\ 4734}# - (%search-load-path #{fn\ 4727}#))) - (if #{t\ 4734}# - #{t\ 4734}# + (let ((#{t 4734}# + (%search-load-path #{fn 4727}#))) + (if #{t 4734}# + #{t 4734}# (syntax-violation 'include-from-path "file not found in path" - #{x\ 4718}# - #{filename\ 4725}#))))))) - (let ((#{fn\ 4731}# #{tmp\ 4729}#)) + #{x 4718}# + #{filename 4725}#))))))) + (let ((#{fn 4731}# #{tmp 4729}#)) (list '#(syntax-object include ((top) @@ -17681,55 +17587,55 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4719"))) (hygiene guile)) - #{fn\ 4731}#)))))) - #{tmp\ 4721}#) + #{fn 4731}#)))))) + #{tmp 4721}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4720}#))))))) + #{tmp 4720}#))))))) (define unquote (make-syntax-transformer 'unquote 'macro - (lambda (#{x\ 4736}#) + (lambda (#{x 4736}#) (syntax-violation 'unquote "expression not valid outside of quasiquote" - #{x\ 4736}#)))) + #{x 4736}#)))) (define unquote-splicing (make-syntax-transformer 'unquote-splicing 'macro - (lambda (#{x\ 4738}#) + (lambda (#{x 4738}#) (syntax-violation 'unquote-splicing "expression not valid outside of quasiquote" - #{x\ 4738}#)))) + #{x 4738}#)))) (define case (make-syntax-transformer 'case 'macro - (lambda (#{x\ 4740}#) - (let ((#{tmp\ 4742}# #{x\ 4740}#)) - (let ((#{tmp\ 4743}# + (lambda (#{x 4740}#) + (let ((#{tmp 4742}# #{x 4740}#)) + (let ((#{tmp 4743}# ($sc-dispatch - #{tmp\ 4742}# + #{tmp 4742}# '(_ any any . each-any)))) - (if #{tmp\ 4743}# + (if #{tmp 4743}# (@apply - (lambda (#{e\ 4747}# #{m1\ 4748}# #{m2\ 4749}#) - (let ((#{tmp\ 4751}# + (lambda (#{e 4747}# #{m1 4748}# #{m2 4749}#) + (let ((#{tmp 4751}# (letrec* - ((#{f\ 4757}# - (lambda (#{clause\ 4758}# #{clauses\ 4759}#) - (if (null? #{clauses\ 4759}#) - (let ((#{tmp\ 4761}# #{clause\ 4758}#)) - (let ((#{tmp\ 4762}# + ((#{f 4757}# + (lambda (#{clause 4758}# #{clauses 4759}#) + (if (null? #{clauses 4759}#) + (let ((#{tmp 4761}# #{clause 4758}#)) + (let ((#{tmp 4762}# ($sc-dispatch - #{tmp\ 4761}# + #{tmp 4761}# '(#(free-id #(syntax-object else @@ -17756,9 +17662,9 @@ any . each-any)))) - (if #{tmp\ 4762}# + (if #{tmp 4762}# (@apply - (lambda (#{e1\ 4765}# #{e2\ 4766}#) + (lambda (#{e1 4765}# #{e2 4766}#) (cons '#(syntax-object begin ((top) @@ -17785,18 +17691,18 @@ #((top)) #("i4741"))) (hygiene guile)) - (cons #{e1\ 4765}# - #{e2\ 4766}#))) - #{tmp\ 4762}#) - (let ((#{tmp\ 4768}# + (cons #{e1 4765}# + #{e2 4766}#))) + #{tmp 4762}#) + (let ((#{tmp 4768}# ($sc-dispatch - #{tmp\ 4761}# + #{tmp 4761}# '(each-any any . each-any)))) - (if #{tmp\ 4768}# + (if #{tmp 4768}# (@apply - (lambda (#{k\ 4772}# - #{e1\ 4773}# - #{e2\ 4774}#) + (lambda (#{k 4772}# + #{e1 4773}# + #{e2 4774}#) (list '#(syntax-object if ((top) @@ -17956,7 +17862,7 @@ #("i4741"))) (hygiene guile)) - #{k\ 4772}#)) + #{k 4772}#)) (cons '#(syntax-object begin ((top) @@ -17999,30 +17905,30 @@ #((top)) #("i4741"))) (hygiene guile)) - (cons #{e1\ 4773}# - #{e2\ 4774}#)))) - #{tmp\ 4768}#) - (let ((#{_\ 4778}# #{tmp\ 4761}#)) + (cons #{e1 4773}# + #{e2 4774}#)))) + #{tmp 4768}#) + (let ((#{_ 4778}# #{tmp 4761}#)) (syntax-violation 'case "bad clause" - #{x\ 4740}# - #{clause\ 4758}#))))))) - (let ((#{tmp\ 4780}# - (#{f\ 4757}# - (car #{clauses\ 4759}#) - (cdr #{clauses\ 4759}#)))) - (let ((#{rest\ 4782}# #{tmp\ 4780}#)) - (let ((#{tmp\ 4783}# #{clause\ 4758}#)) - (let ((#{tmp\ 4784}# + #{x 4740}# + #{clause 4758}#))))))) + (let ((#{tmp 4780}# + (#{f 4757}# + (car #{clauses 4759}#) + (cdr #{clauses 4759}#)))) + (let ((#{rest 4782}# #{tmp 4780}#)) + (let ((#{tmp 4783}# #{clause 4758}#)) + (let ((#{tmp 4784}# ($sc-dispatch - #{tmp\ 4783}# + #{tmp 4783}# '(each-any any . each-any)))) - (if #{tmp\ 4784}# + (if #{tmp 4784}# (@apply - (lambda (#{k\ 4788}# - #{e1\ 4789}# - #{e2\ 4790}#) + (lambda (#{k 4788}# + #{e1 4789}# + #{e2 4790}#) (list '#(syntax-object if ((top) @@ -18211,7 +18117,7 @@ #("i4741"))) (hygiene guile)) - #{k\ 4788}#)) + #{k 4788}#)) (cons '#(syntax-object begin ((top) @@ -18262,18 +18168,18 @@ #((top)) #("i4741"))) (hygiene guile)) - (cons #{e1\ 4789}# - #{e2\ 4790}#)) - #{rest\ 4782}#)) - #{tmp\ 4784}#) - (let ((#{_\ 4794}# #{tmp\ 4783}#)) + (cons #{e1 4789}# + #{e2 4790}#)) + #{rest 4782}#)) + #{tmp 4784}#) + (let ((#{_ 4794}# #{tmp 4783}#)) (syntax-violation 'case "bad clause" - #{x\ 4740}# - #{clause\ 4758}#))))))))))) - (begin (#{f\ 4757}# #{m1\ 4748}# #{m2\ 4749}#))))) - (let ((#{body\ 4753}# #{tmp\ 4751}#)) + #{x 4740}# + #{clause 4758}#))))))))))) + (begin (#{f 4757}# #{m1 4748}# #{m2 4749}#))))) + (let ((#{body 4753}# #{tmp 4751}#)) (list '#(syntax-object let ((top) @@ -18301,42 +18207,41 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4741"))) (hygiene guile)) - #{e\ 4747}#)) - #{body\ 4753}#)))) - #{tmp\ 4743}#) + #{e 4747}#)) + #{body 4753}#)))) + #{tmp 4743}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4742}#))))))) + #{tmp 4742}#))))))) (define make-variable-transformer - (lambda (#{proc\ 4795}#) - (if (procedure? #{proc\ 4795}#) + (lambda (#{proc 4795}#) + (if (procedure? #{proc 4795}#) (begin (letrec* - ((#{trans\ 4798}# - (lambda (#{x\ 4799}#) - (#{proc\ 4795}# #{x\ 4799}#)))) + ((#{trans 4798}# + (lambda (#{x 4799}#) (#{proc 4795}# #{x 4799}#)))) (begin (set-procedure-property! - #{trans\ 4798}# + #{trans 4798}# 'variable-transformer #t) - #{trans\ 4798}#))) + #{trans 4798}#))) (error "variable transformer not a procedure" - #{proc\ 4795}#)))) + #{proc 4795}#)))) (define identifier-syntax (make-syntax-transformer 'identifier-syntax 'macro - (lambda (#{x\ 4801}#) - (let ((#{tmp\ 4803}# #{x\ 4801}#)) - (let ((#{tmp\ 4804}# - ($sc-dispatch #{tmp\ 4803}# '(_ any)))) - (if #{tmp\ 4804}# + (lambda (#{x 4801}#) + (let ((#{tmp 4803}# #{x 4801}#)) + (let ((#{tmp 4804}# + ($sc-dispatch #{tmp 4803}# '(_ any)))) + (if #{tmp 4804}# (@apply - (lambda (#{e\ 4806}#) + (lambda (#{e 4806}#) (list '#(syntax-object lambda ((top) @@ -18419,7 +18324,7 @@ #((top)) #("i4802"))) (hygiene guile)) - #{e\ 4806}#)) + #{e 4806}#)) (list '(#(syntax-object _ ((top) @@ -18451,7 +18356,7 @@ #((top)) #("i4802"))) (hygiene guile)) - (cons #{e\ 4806}# + (cons #{e 4806}# '(#(syntax-object x ((top) @@ -18478,10 +18383,10 @@ #((top)) #("i4802"))) (hygiene guile))))))))) - #{tmp\ 4804}#) - (let ((#{tmp\ 4807}# + #{tmp 4804}#) + (let ((#{tmp 4807}# ($sc-dispatch - #{tmp\ 4803}# + #{tmp 4803}# '(_ (any any) ((#(free-id #(syntax-object @@ -18493,24 +18398,24 @@ any any) any))))) - (if (if #{tmp\ 4807}# + (if (if #{tmp 4807}# (@apply - (lambda (#{id\ 4813}# - #{exp1\ 4814}# - #{var\ 4815}# - #{val\ 4816}# - #{exp2\ 4817}#) - (if (identifier? #{id\ 4813}#) - (identifier? #{var\ 4815}#) + (lambda (#{id 4813}# + #{exp1 4814}# + #{var 4815}# + #{val 4816}# + #{exp2 4817}#) + (if (identifier? #{id 4813}#) + (identifier? #{var 4815}#) #f)) - #{tmp\ 4807}#) + #{tmp 4807}#) #f) (@apply - (lambda (#{id\ 4825}# - #{exp1\ 4826}# - #{var\ 4827}# - #{val\ 4828}# - #{exp2\ 4829}#) + (lambda (#{id 4825}# + #{exp1 4826}# + #{var 4827}# + #{val 4828}# + #{exp2 4829}#) (list '#(syntax-object make-variable-transformer ((top) @@ -18641,8 +18546,8 @@ #((top)) #("i4802"))) (hygiene guile)) - #{var\ 4827}# - #{val\ 4828}#) + #{var 4827}# + #{val 4828}#) (list '#(syntax-object syntax ((top) @@ -18664,8 +18569,8 @@ #((top)) #("i4802"))) (hygiene guile)) - #{exp2\ 4829}#)) - (list (cons #{id\ 4825}# + #{exp2 4829}#)) + (list (cons #{id 4825}# '(#(syntax-object x ((top) @@ -18737,7 +18642,7 @@ #((top)) #("i4802"))) (hygiene guile)) - (cons #{exp1\ 4826}# + (cons #{exp1 4826}# '(#(syntax-object x ((top) @@ -18795,7 +18700,7 @@ #("i4802"))) (hygiene guile)))))) - (list #{id\ 4825}# + (list #{id 4825}# (list '#(syntax-object identifier? ((top) @@ -18842,7 +18747,7 @@ #((top)) #("i4802"))) (hygiene guile)) - #{id\ 4825}#)) + #{id 4825}#)) (list '#(syntax-object syntax ((top) @@ -18864,29 +18769,29 @@ #((top)) #("i4802"))) (hygiene guile)) - #{exp1\ 4826}#)))))) - #{tmp\ 4807}#) + #{exp1 4826}#)))))) + #{tmp 4807}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4803}#))))))))) + #{tmp 4803}#))))))))) (define define* (make-syntax-transformer 'define* 'macro - (lambda (#{x\ 4830}#) - (let ((#{tmp\ 4832}# #{x\ 4830}#)) - (let ((#{tmp\ 4833}# + (lambda (#{x 4830}#) + (let ((#{tmp 4832}# #{x 4830}#)) + (let ((#{tmp 4833}# ($sc-dispatch - #{tmp\ 4832}# + #{tmp 4832}# '(_ (any . any) any . each-any)))) - (if #{tmp\ 4833}# + (if #{tmp 4833}# (@apply - (lambda (#{id\ 4838}# - #{args\ 4839}# - #{b0\ 4840}# - #{b1\ 4841}#) + (lambda (#{id 4838}# + #{args 4839}# + #{b0 4840}# + #{b1 4841}#) (list '#(syntax-object define ((top) @@ -18897,7 +18802,7 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)) - #{id\ 4838}# + #{id 4838}# (cons '#(syntax-object lambda* ((top) @@ -18908,14 +18813,14 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)) - (cons #{args\ 4839}# - (cons #{b0\ 4840}# #{b1\ 4841}#))))) - #{tmp\ 4833}#) - (let ((#{tmp\ 4843}# - ($sc-dispatch #{tmp\ 4832}# '(_ any any)))) - (if (if #{tmp\ 4843}# + (cons #{args 4839}# + (cons #{b0 4840}# #{b1 4841}#))))) + #{tmp 4833}#) + (let ((#{tmp 4843}# + ($sc-dispatch #{tmp 4832}# '(_ any any)))) + (if (if #{tmp 4843}# (@apply - (lambda (#{id\ 4846}# #{val\ 4847}#) + (lambda (#{id 4846}# #{val 4847}#) (identifier? '#(syntax-object x @@ -18927,10 +18832,10 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)))) - #{tmp\ 4843}#) + #{tmp 4843}#) #f) (@apply - (lambda (#{id\ 4850}# #{val\ 4851}#) + (lambda (#{id 4850}# #{val 4851}#) (list '#(syntax-object define ((top) @@ -18941,11 +18846,11 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i4831"))) (hygiene guile)) - #{id\ 4850}# - #{val\ 4851}#)) - #{tmp\ 4843}#) + #{id 4850}# + #{val 4851}#)) + #{tmp 4843}#) (syntax-violation #f "source expression failed to match any pattern" - #{tmp\ 4832}#))))))))) + #{tmp 4832}#))))))))) From 62ef23cbb828accf1f5b9622ff17775aa539d354 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 11 Apr 2011 17:21:20 +0200 Subject: [PATCH 180/183] fix reader.test for --disable-deprecated * test-suite/tests/reader.test: Fix deprecated tests; begin-deprecated was splicing in expression context before, which is a no-no. --- test-suite/tests/reader.test | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 7027d3255..f350e73a6 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -430,12 +430,13 @@ (pass-if (equal? (read-string "#{}#") '#{}#)) (pass-if (equal? (read-string "#{a}#") 'a)) (pass-if (equal? (read-string "#{a b}#") '#{a b}#)) - (begin-deprecated - (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))) (pass-if-exception "#{" exception:eof-in-symbol (read-string "#{")) (pass-if (equal? (read-string "#{a\\x20;b}#") '#{a b}#))) +(begin-deprecated + (with-test-prefix "deprecated #{}# escapes" + (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#)))) ;;; Local Variables: ;;; eval: (put 'with-read-options 'scheme-indent-function 1) From cf9d4a82146556ff45d40d6eec8579082287900e Mon Sep 17 00:00:00 2001 From: Ian Price Date: Wed, 6 Apr 2011 01:53:38 +0100 Subject: [PATCH 181/183] Added optional second arg to R6RS log function * module/rnrs/base.scm (log): now takes a base argument, using the change of base formula for logs. * test-suite/tests/r6rs-base.test ("log (2nd arg)"): Add test cases. --- module/rnrs/base.scm | 9 +++++++++ test-suite/tests/r6rs-base.test | 16 ++++++++++++++++ 2 files changed, 25 insertions(+) diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index b9dddab0b..b867929fe 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -74,6 +74,7 @@ syntax-rules identifier-syntax) (import (rename (except (guile) error raise) + (log log-internal) (euclidean-quotient div) (euclidean-remainder mod) (euclidean/ div-and-mod) @@ -85,6 +86,14 @@ (inexact->exact exact)) (srfi srfi-11)) + (define log + (case-lambda + ((n) + (log-internal n)) + ((n base) + (/ (log n) + (log base))))) + (define (boolean=? . bools) (define (boolean=?-internal lst last) (or (null? lst) diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test index 1509b04ed..dfddf7c34 100644 --- a/test-suite/tests/r6rs-base.test +++ b/test-suite/tests/r6rs-base.test @@ -21,6 +21,22 @@ :use-module ((rnrs base) :version (6)) :use-module (test-suite lib)) + +;; numbers are considered =? if their difference is less than a set +;; tolerance +(define (=? alpha beta) + (< (abs (- alpha beta)) 1e-10)) + +(with-test-prefix "log (2nd arg)" + (pass-if "log positive-base" (=? (log 8 2) 3)) + (pass-if "log negative-base" (=? (real-part (log 256 -4)) + 0.6519359443)) + (pass-if "log base-one" (= (log 10 1) +inf.0)) + (pass-if "log base-zero" + (catch #t + (lambda () (log 10 0) #f) + (lambda args #t)))) + (with-test-prefix "boolean=?" (pass-if "boolean=? null" (boolean=?)) (pass-if "boolean=? unary" (boolean=? #f)) From 15993bce1cd0a2e69f11a6ac1725fa7a219c5b7c Mon Sep 17 00:00:00 2001 From: Ian Price Date: Wed, 6 Apr 2011 13:51:44 +0100 Subject: [PATCH 182/183] fix assert to return true value. * module/rnrs/base.scm (assert): returns value instead of void. * test-suite/tests/r6rs-base.test ("assert"): add test cases. --- module/rnrs/base.scm | 2 +- test-suite/tests/r6rs-base.test | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index b867929fe..4cfd1d1cc 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -175,7 +175,7 @@ (define-syntax assert (syntax-rules () ((_ expression) - (if (not expression) + (or expression (raise (condition (make-assertion-violation) (make-message-condition diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test index dfddf7c34..df11d67b3 100644 --- a/test-suite/tests/r6rs-base.test +++ b/test-suite/tests/r6rs-base.test @@ -19,6 +19,8 @@ (define-module (test-suite test-r6rs-base) :use-module ((rnrs base) :version (6)) + :use-module ((rnrs conditions) :version (6)) + :use-module ((rnrs exceptions) :version (6)) :use-module (test-suite lib)) @@ -188,3 +190,9 @@ (pass-if (not (integer-valued? +0.01i))) (pass-if (not (integer-valued? -inf.0i)))) +(with-test-prefix "assert" + (pass-if "assert returns value" (= 1 (assert 1))) + (pass-if "assertion-violation" + (guard (condition ((assertion-violation? condition) #t)) + (assert #f) + #f))) From c89b45299329d034875429804f18768c1ea96713 Mon Sep 17 00:00:00 2001 From: Ian Price Date: Fri, 8 Apr 2011 02:49:20 +0100 Subject: [PATCH 183/183] Fix fencepost error in bip_seek * libguile/r6rs-ports.c (bip_seek): Fix to allow seeking to end of port. * test-suite/tests/r6rs-ports.test ("bytevector input port can seek to very end"): Add tests. --- libguile/r6rs-ports.c | 2 +- test-suite/tests/r6rs-ports.test | 9 +++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 1f724158a..7473db94b 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -136,7 +136,7 @@ bip_seek (SCM port, scm_t_off offset, int whence) /* Fall through. */ case SEEK_SET: - if (c_port->read_buf + offset < c_port->read_end) + if (c_port->read_buf + offset <= c_port->read_end) { c_port->read_pos = c_port->read_buf + offset; c_result = offset; diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 70b5853b2..01d8235fa 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -320,6 +320,15 @@ (u8-list->bytevector (map char->integer (string->list "Port!"))))))) + (pass-if "bytevector input port can seek to very end" + (let ((empty (open-bytevector-input-port '#vu8())) + (not-empty (open-bytevector-input-port '#vu8(1 2 3)))) + (and (begin (set-port-position! empty (port-position empty)) + (= 0 (port-position empty))) + (begin (get-bytevector-n not-empty 3) + (set-port-position! not-empty (port-position not-empty)) + (= 3 (port-position not-empty)))))) + (pass-if-exception "make-custom-binary-input-port [wrong-num-args]" exception:wrong-num-args