[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.0.0-196-g0c81a0c
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.0.0-196-g0c81a0c |
|
Date: |
Mon, 11 Apr 2011 22:15:47 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=0c81a0c13ad39c381e4ff4d073e3158bcfd51a7a
The branch, master has been updated
via 0c81a0c13ad39c381e4ff4d073e3158bcfd51a7a (commit)
via 21c05db45b69f8a62b84c36abc86cb935fa967d7 (commit)
via c89b45299329d034875429804f18768c1ea96713 (commit)
via 15993bce1cd0a2e69f11a6ac1725fa7a219c5b7c (commit)
via cf9d4a82146556ff45d40d6eec8579082287900e (commit)
via 62ef23cbb828accf1f5b9622ff17775aa539d354 (commit)
via b9e22602bb9c7d82500e4e5612bf80e478e28b8c (commit)
via 2e9fc9fc73a8157152e6b2e122ec545d96478c2a (commit)
via d9527cfafdad1046770437a7a59d3745e7243c67 (commit)
via 15671c6e7fd86160b415b5373b2c1539e23556f3 (commit)
via adf43b3f081878860ed1d4d5091b9a432b44da90 (commit)
via 882c89636a2a4afa26cff17c7cdbc1d8c1cb2745 (commit)
via b1e13fb530e0f80334862e440860c054b61dbdd0 (commit)
via 40c2a95a72b3a831d9de319afbc9d72a0133110e (commit)
via 165b10ddfaaa8ecc72d45a9be7d29e7537dc2379 (commit)
via 6ebecdeb7da37a1ff0ab1d01e2f2fec225667a74 (commit)
via ce6066065dda2cf1854f6a63324abb75dc0bc23f (commit)
via df941b5b62721d061ce5381a1a6400609e8a10b8 (commit)
via 78d1be4aef408248bbb545d4b94b4b1335a4ab88 (commit)
via b7715701b488a1de87c7767bc437a853f10001ee (commit)
via 90fed973abf1d55212d7a43f8450f5fe76d9e6a2 (commit)
via 39bed56f670267f66d99f98cd58978871b789557 (commit)
via c6b08d21947b1b33de1e8cd364553112d4015253 (commit)
via 13a78b0fd75a4825de0624e47911810fe8a5d150 (commit)
via 355dd8cb4bff2821f4b4da2bd989441b882ed5de (commit)
via d050ef66eceb764e0c26e535140ebed795b546fa (commit)
via 1c8a6308c0050189a777d9384f270aea3206c2e0 (commit)
via 987b8160f58185c50c4cf4703eb15f04f6cd9f89 (commit)
via 09b7459b49f699a0ef95223bd35a0e88b8437a56 (commit)
via 2ebdf6b5551646804e3adc2fc4a9acb896210f89 (commit)
via 8a12aeb9193a498c0b85c2de4d2ee1543ccb720d (commit)
via d8f699e8eb6e5dfdbaf38e8bea15711b5b29c417 (commit)
via f929b9e5ec39391bee1d0ce256b59b0c610caa25 (commit)
via 0f1fd214f184a998a3d8e1580b7acb9d02dc879b (commit)
via e309f3bf9ee910c4772353ca3ff95f6f4ef466b5 (commit)
via 653ccd78fa6770c692f5a737ad70de5aedbfcc7f (commit)
via 4000d0641f8a2282a9c52eea33ad91c76625d906 (commit)
via 443f25dcff49f0a920d4149e29bcb3ae9f64ee02 (commit)
via 572eef50c2d902d34427945dd504ba03af666e48 (commit)
via 8cf49d836ff41838812cba1fd61bfce3fb877144 (commit)
via fb6df3ea137eabad25d70219da2c84282883b433 (commit)
via 2460274d360d36bc758b763a1bbb1dc2cb85a87b (commit)
via 56dbc8a89958fcc401b0980ffcd0047f20470cd3 (commit)
via 9dadfa47b07548ff5cf3604067910c8aece93c42 (commit)
via 62f528e929368ddce77f550168c229177793d854 (commit)
via 8e9af8541253577c15c94455ef31c762071aae64 (commit)
via 96c71c589a866e41b3a95ccc90318c6a28e42004 (commit)
via 38c50a99b695694b684662663294eaeba2bcba30 (commit)
via 362126aa96cbe2429d2a6202d0be63de6f93505b (commit)
via c6e05396dc73c3bcfa71b92b4689e8cb6d4588eb (commit)
via 6b8bc6f8b507928f9b0bd71000f5132c984db798 (commit)
via aab99f7b8b74204993c7b9f8bc4ac3703551028b (commit)
via 08e6b25ca2184bed67d38be4db26561ee713b290 (commit)
via 29ee01c009c46969a6b5570daf0a021a541c2d17 (commit)
via 7f22442b2af85ea9db89c84fbd3acb6a96ee13fd (commit)
via 12c1d8616d8dfedcad65f34e3968f9544b629ae1 (commit)
via 2a6f90e52436afdbbcdcf99bfe8a5c24cefd9769 (commit)
via 5f0d2951a0a5179038bee55fe9af688f94738075 (commit)
via ecba00af6501e082b86c8f2f7730081c733509d7 (commit)
via ad301b6d58c2ca054ebe1fdfaf7357e61311a977 (commit)
via 8099352769c8b8ec8730f87f7fa6c8771b64efb9 (commit)
via 190d4b0d93599e5b58e773dc6375054c3a6e3dbf (commit)
via 95c1cfb550e2e753324c5cc57ef5df90034f072a (commit)
via 13f1461c2417cc80f050beb4c11a94deb60defae (commit)
via 75847d5767df6321adcd47e92d1a986333d4e9bd (commit)
via d78de77f43e94c72602f3541ca672d6035607c81 (commit)
via 6f2ff78299f54b1fde9f2ff85cbabf876bea85b8 (commit)
via f60a7648d5926555c7760364a6fbb7dc0cf60720 (commit)
via 60582b7c2a495957012f9a20cd8691dc6307a850 (commit)
via e4612ff64201284167f71ac4c09ddb1959f66eb8 (commit)
via c428d33d3220c96026c54075ab28021a0aeff755 (commit)
via f80ed1be36b9ff86291e7103488aeb06ab9c092e (commit)
via 95f5e303bc7f6174255b12fd1113d69364863762 (commit)
via bb455e4f94d8e339c9b8a69e178110cf3dfa5bcb (commit)
via 17ab1dc3d630dcaeee45e1cb42a8f8699585eea0 (commit)
via 03976fee3b342f9da6fff41bc619c45a12372dfa (commit)
via 148c3317691d5b7d2414179031f87905454cb11a (commit)
via f5fc7e5710438389b21c5c754e959a5554561868 (commit)
via 9b709b0fe1ec5a71903e07d21006441d15e0c1ed (commit)
via 958173e489c69b2f9e3c83752713a89e3ea3e79d (commit)
via ead04a04cd38909d0d40f1ba7885372c9c65ff38 (commit)
via 74571cfd3b27b79567f27fc43815d08ec1f402cc (commit)
via a6c377f7d8a311b0ce4f9c5900b1c81c27b2d60c (commit)
via ca33b501a93f8de389c1e3e1bc987f63b6912029 (commit)
via b075a6d766c2ffe7c575b63648d8ae0d51b5dd3a (commit)
via bfb85df7084e26a276142cdc62315a85c7a0ba20 (commit)
via 06fc34c23f2c6987ba1dc8cbf5a084ff24a83e53 (commit)
via 514642d3c7b5406952e5461918b718e13a06a2c1 (commit)
via d82f8518b96bbfa4f29e03d922369c37b64824d9 (commit)
via dd36ce77cd899c7b179026603e751e3bb47b2943 (commit)
via df1297956211b7353155c9b54d7e9c22d05ce493 (commit)
via 531c9f1dc51c4801c4d031ee80a31f15285a6b85 (commit)
via c428e58681fbd006d253bda51b3543110b317b8d (commit)
via ce3ce21c623771ecafdf80c98519e80048cfedb7 (commit)
via ddf134cfec0d82ea9f39ddd69948c08feecb9576 (commit)
via 495a39c40f8c31479272495c3a550695077ac335 (commit)
via e3c15cf7a61ca79b67f510624cdc1631e3662b20 (commit)
via 18d78c5e3585b06e5f588ba1ae919e189afeaa73 (commit)
via 4f1bbedb6db54acc0a0ceea81dc79220bbbcb1b3 (commit)
via 73ea546c51c5ca531cc6040eb37e292a8334b33e (commit)
via 831e6782bfa776c30286ef14f1356b9d5aa8f1ee (commit)
via c2e56d9b0727d50a90917ea6b79f17ebe2d35c98 (commit)
via 13459a961946526dc8f1277a6d4d319f848da1ab (commit)
via f32e67be0b1390f22382eed10459016ca37c126d (commit)
via 534491d0b7fcd17558751110610bcef971d414a8 (commit)
via 0b0e066a26b437f7320abd126ec05a7a7c056dd9 (commit)
via ef8e9356de2494d378948614945ec9aa4498d91c (commit)
via 65ea26c5824bc3be9d327b4470d19e67d7b5d44d (commit)
via 821eca02eb50cb65d41f72fe99acbebd5bc5cc7d (commit)
via 364b6eb7cfc39f18477b8f62c1e5d58a1efae69b (commit)
via 8b2633771269173b55e9808b030a9312e8554aef (commit)
via ceed7709becfe64eaaff54aa445b09d1882d589d (commit)
via d8f1c2162c3a34f4bc29ee7f6fab426e6e11e36a (commit)
via 0b2c2ba353d9dcf0b288950b88d6f205a5ec67ab (commit)
via 691fcf66c0a823b2c4f4018e925cf9f338a4de27 (commit)
via d59dd06eb9a3a45b9a385421555b2414345d7272 (commit)
via b6b84131cd2cf36b49e65f30a67dbc114b78c610 (commit)
via 900a6f87bad5c5a34f017cc6c851483758433f38 (commit)
via fd029c35de681efe530ba1e054e918c69d3602ef (commit)
via 2dea6a4d33561e1403b1c330f2b8ed3d87f0d1c6 (commit)
via 090f14b890ec31844bca6b93256a39d3bd80aba3 (commit)
via 47b86dbf4dc3da2f4d6d41a018cd221fbf0823ee (commit)
via c7d6f8b27949e12b6e358e4c9580affddb339af6 (commit)
via 65fa60ca7a7bbfd712371f7b2471efe7b056839c (commit)
via 859e58ae8a77c0c725a5027d1bb3809e9772076e (commit)
via d900843c72ee1f34d79527deb38787e581592cf5 (commit)
via 8d795c83d463e893cdac16733fd42bef809c0d79 (commit)
via 51c0fd808683fdea689a91fb13b367fd98998c7a (commit)
via 9c3fa20a561e6693314fda9ad713ce70a80b88de (commit)
via fba502dbccfa57c6a8f5b7bffa4fddfb22725677 (commit)
via bd79ebf3188ad0dc9f45290112f603f33af86f88 (commit)
via 58b1db5f2437327e0d44cfe799ca8e21e27d5b5e (commit)
via ac012a27a2e3c28f191d2c38b3d1ab1ef70ba8ba (commit)
via 6a94e6e1ae6c018fe1ea1c0c6a9cca577dff4d85 (commit)
via 62cdb4e478d58ade852b04bdcfcf79c1ac815e21 (commit)
via dcb7c7ddf5dc2c7e32720ed91c6d7bbed7f7455a (commit)
via 4e33a13246751034adbcc53f9e93223e19f57db2 (commit)
via 450aee6790e325b8fbf1102c3403255bf3fc571f (commit)
via 4335366389364885239dd5189ca747ed1d59e569 (commit)
via fa3df855e831d6782af68f6e2219fcde07cfb8ca (commit)
via 4da326f25dec2a2799c7be90cd026955be46525e (commit)
via 4c2e13e548ad251dc0431e745c94e25e7cc36aef (commit)
via 249f2788c6c9d6c0ddfbca37c8a6bfab42b22374 (commit)
via 6800f86d63c4953fe705f6f74e252fb2bd9cc8c8 (commit)
via 080a9d4f564c1b4e2171aa35a2a50fe20c300ecd (commit)
via 914c4300b2e6857152363529706799ae692bc2a4 (commit)
via cfad56a4449011e34aa917136cb6844ef453edcc (commit)
via 62c290e977ea71c8dcb9ccb45e5a06d9e5a13a40 (commit)
via ec7f624d652eaf6e4cf06253101b4a986e1b9e8e (commit)
via 574b7be0ba5dbbecfacf172ed81a5f22d1d5566e (commit)
via b2548e23445d44f9b6f0b21d07c0ee94c83d0607 (commit)
via a964aa62c273d93fad61ae67abd98027e1d142d3 (commit)
via 4a2ac0623c3dabb2c8b9d38c27b837dcb2c7fe4e (commit)
via 40d2a0076af69c3227bc13606aebdb5822ed7f0d (commit)
via 85bdb6ac9c8893b88c8d71a8864f019f1127eba3 (commit)
via da0c22b5d307752770eec9ad218f018d55d403d9 (commit)
via 1e1808c920fb0defe75850af26fae199e1090384 (commit)
via 2a39def1a8f9dc814083f51acc3dd8a5819afeff (commit)
via 8bc5b79df78aeefa8fc15b040deb43fb14846d26 (commit)
via 9d798af739a6b3a1fa66c19bc5864bdd57e8d5b5 (commit)
via 630b6588b7b26bf96874b235ff43ee4c3974cce3 (commit)
via 0e8a11c49a0ccc8d76807133e9abf82f8e14d1ec (commit)
via 097a793b2225039980c2b6309661cb23326903f1 (commit)
via f244cc515447f8fb7d2f10038e88636cf9cf5068 (commit)
via 4b93693dffb2a4bd0d0da137b4d768ca3e68e8f1 (commit)
via 1867d3e0195168a34cf2269c2137ac561d03a252 (commit)
via 5ec48b704522c861c6e34ed1cbbfec5b89d55376 (commit)
via e888334c27c218cb187a6540d2182232361eb7c3 (commit)
via 27643d70976b1d5cf2ecea50cf11130654c01ba4 (commit)
via bba1a2c73d93a1b47712151ea9b0d28953e517e7 (commit)
via ed478161f38b3c1bbe2a37a18e0b49d92f399df0 (commit)
via b0fc1b9f379e31ed5755ff991e9d8c97ce67fc8c (commit)
via d9ff8506b32495393a77b7a2d077172d12571a34 (commit)
via 476a51eb3893d780a1935c0754c9e7854dda8d5a (commit)
via a46f77f95cfcc1b4e4de94d1bc135e4d48808725 (commit)
via 8fa6525e82a0fc6f9afabd913e0f64ba158449d8 (commit)
via 6bc746d8657de2fd9053b56178770f6c1b151477 (commit)
via 3e05fc04668f2e2c0f0aa989d7adf11bef49ec84 (commit)
via 6854c32480e95ca54e95da585e74002d8897573c (commit)
via dd0d987fbdf32387ff4b36631302918ca8ff36cb (commit)
via 7e23d9d0f1efd8d62e8fbe1341d0e1ea54b2eb57 (commit)
via 958a28e9fec33ebb4673294308a82ccd18cc6071 (commit)
via a5f6b751be7991134fc27c47510fc73038a25a5a (commit)
via c05696aa940c276ce6ee4ceeb853e562898c190a (commit)
via 7bfedb87078d3119913e51511ba35e2fbc6f6d5c (commit)
from 4db853d747ac115f799c93e2de93f5159ad84109 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 0c81a0c13ad39c381e4ff4d073e3158bcfd51a7a
Author: Andy Wingo <address@hidden>
Date: Mon Apr 11 23:40:51 2011 +0200
bump effective version to 2.2
* .gitignore:
* GUILE-VERSION (GUILE_EFFECTIVE_VERSION):
* configure.ac:
* doc/example-smob/Makefile (CFLAGS, LIBS):
* doc/guile.1:
* doc/ref/libguile-concepts.texi:
* doc/ref/srfi-modules.texi:
* doc/ref/vm.texi:
* meta/Makefile.am (EXTRA_DIST, pkgconfig_DATA):
* meta/guile-config.in (guile-module):
* meta/guile-2.2-uninstalled.pc.in:
* meta/guile-2.2.pc.in: Bump effective version to 2.2.
commit 21c05db45b69f8a62b84c36abc86cb935fa967d7
Merge: 4db853d c89b452
Author: Andy Wingo <address@hidden>
Date: Mon Apr 11 23:30:52 2011 +0200
Merge remote branch 'origin/stable-2.0'
Conflicts:
GUILE-VERSION
test-suite/tests/srfi-4.test
-----------------------------------------------------------------------
Summary of changes:
.gitignore | 4 +-
GUILE-VERSION | 2 +-
Makefile.am | 4 +-
NEWS | 15 +
README | 22 +-
THANKS | 1 +
am/Makefile.am | 2 +-
am/pre-inst-guile | 34 -
benchmark-suite/Makefile.am | 4 +-
benchmark-suite/benchmarks/arithmetic.bm | 2 +-
.../benchmarks/r6rs-arithmetic.bm | 28 +-
benchmark-suite/benchmarks/strings.bm | 537 +
build-aux/config.rpath | 97 +-
build-aux/git-version-gen | 31 +-
configure.ac | 46 +-
doc/example-smob/Makefile | 4 +-
doc/guile.1 | 295 +-
doc/ref/Makefile.am | 7 +-
doc/ref/api-data.texi | 40 +-
doc/ref/api-evaluation.texi | 57 +-
doc/ref/api-foreign.texi | 53 +-
doc/ref/api-io.texi | 8 +-
doc/ref/api-modules.texi | 65 +-
doc/ref/api-options.texi | 13 +-
doc/ref/api-procedures.texi | 29 +-
doc/ref/autoconf.texi | 16 +-
doc/ref/goops.texi | 850 +-
doc/ref/history.texi | 12 +-
doc/ref/libguile-concepts.texi | 24 +-
doc/ref/libguile-extensions.texi | 7 +-
doc/ref/libguile-linking.texi | 77 +-
doc/ref/libguile-smobs.texi | 8 +-
doc/ref/r6rs.texi | 55 +-
doc/ref/scheme-scripts.texi | 5 +
doc/ref/scheme-using.texi | 60 +-
doc/ref/srfi-modules.texi | 19 +-
doc/ref/tools.texi | 33 +-
doc/ref/tour.texi | 7 +-
doc/ref/vm.texi | 12 +-
doc/ref/web.texi | 35 +-
gc-benchmarks/Makefile.am | 55 +
gc-benchmarks/gc-profile.scm | 11 +-
lib/Makefile.am | 58 +-
lib/{trunc.c => ceil.c} | 20 +-
lib/dosname.h | 53 +
lib/flock.c | 34 +-
lib/frexp.c | 166 +
lib/{isnanl.c => isnand-nolibm.h} | 23 +-
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 +-
libguile/array-handle.h | 42 +-
libguile/arrays.c | 4 +-
libguile/backtrace.c | 12 +-
libguile/bdw-gc.h | 7 +-
libguile/continuations.c | 67 +-
libguile/control.c | 8 +-
libguile/control.h | 4 +-
libguile/deprecated.c | 2 +-
libguile/dynl.c | 5 +-
libguile/eval.c | 23 +-
libguile/eval.h | 6 +-
libguile/filesys.c | 5 +-
libguile/foreign.c | 130 +-
libguile/foreign.h | 4 +-
libguile/frames.c | 6 +-
libguile/gc.c | 74 +-
libguile/gdbint.c | 12 +-
libguile/gen-scmconfig.c | 18 +
libguile/goops.c | 2 +-
libguile/guile-snarf.in | 15 +-
libguile/hashtab.c | 100 +-
libguile/i18n.c | 43 +-
libguile/init.c | 28 +-
libguile/init.h | 4 +-
libguile/modules.c | 122 +
libguile/modules.h | 17 +-
libguile/numbers.c | 74 +-
libguile/numbers.h | 2 +
libguile/objcodes.c | 170 +-
libguile/ports.c | 24 +-
libguile/posix.c | 4 +-
libguile/print.c | 201 +-
libguile/procs.c | 3 +-
libguile/pthread-threads.h | 23 +-
libguile/r6rs-ports.c | 44 +-
libguile/r6rs-ports.h | 3 +-
libguile/read.c | 139 +-
libguile/snarf.h | 8 +-
libguile/socket.c | 2 +-
libguile/srfi-13.c | 30 +-
libguile/srfi-14.c | 4 +-
libguile/stacks.c | 2 -
libguile/strings.c | 94 +-
libguile/strings.h | 7 +-
libguile/strports.c | 181 +-
libguile/symbols.c | 16 +-
libguile/threads.c | 451 +-
libguile/threads.h | 13 +-
libguile/throw.c | 2 +-
libguile/vm-engine.c | 2 +-
libguile/vm-i-loader.c | 4 +-
libguile/vm-i-scheme.c | 54 +-
libguile/vm-i-system.c | 51 +-
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 +-
meta/Makefile.am | 6 +-
...installed.pc.in => guile-2.2-uninstalled.pc.in} | 0
meta/{guile-2.0.pc.in => guile-2.2.pc.in} | 0
meta/guile-config.in | 4 +-
meta/guile.m4 | 43 +-
meta/uninstalled-env.in | 3 +
module/Makefile.am | 9 +-
module/ice-9/binary-ports.scm | 50 +
module/ice-9/boot-9.scm | 69 +-
module/ice-9/eval-string.scm | 88 +
module/ice-9/popen.scm | 6 +-
module/ice-9/psyntax-pp.scm |32112 ++++++++++----------
module/ice-9/psyntax.scm | 284 +-
module/ice-9/vlist.scm | 23 +-
module/language/assembly/compile-bytecode.scm | 6 +-
module/language/elisp/lexer.scm | 2 +-
module/language/objcode/spec.scm | 4 +-
module/language/tree-il.scm | 7 +-
module/language/tree-il/analyze.scm | 7 +-
module/language/tree-il/compile-glil.scm | 8 +-
module/language/tree-il/fix-letrec.scm | 22 +-
module/rnrs.scm | 9 +-
module/rnrs/arithmetic/fixnums.scm | 99 +-
module/rnrs/base.scm | 49 +-
module/rnrs/io/ports.scm | 68 +-
module/scripts/README | 23 +-
module/srfi/srfi-4/gnu.scm | 10 +-
module/srfi/srfi-9.scm | 29 +-
module/system/base/compile.scm | 29 +-
module/system/foreign.scm | 15 +-
module/system/repl/command.scm | 48 +-
module/system/repl/common.scm | 9 +-
module/system/repl/debug.scm | 32 +-
module/system/repl/error-handling.scm | 71 +-
module/system/repl/repl.scm | 85 +-
module/system/repl/server.scm | 3 +-
module/texinfo/html.scm | 12 +-
module/texinfo/reflection.scm | 4 +-
module/web/request.scm | 2 +-
module/web/response.scm | 2 +-
module/web/server.scm | 33 +-
module/web/uri.scm | 101 +-
test-suite/Makefile.am | 2 +
test-suite/standalone/Makefile.am | 41 +-
test-suite/standalone/test-guile-snarf | 22 +
.../standalone/test-mb-regexp | 28 +-
test-suite/tests/coding.test | 104 +
test-suite/tests/continuations.test | 13 +-
test-suite/tests/control.test | 123 +-
test-suite/tests/eval-string.test | 54 +
test-suite/tests/foreign.test | 54 +-
test-suite/tests/goops.test | 11 +-
test-suite/tests/i18n.test | 89 +-
test-suite/tests/modules.test | 45 +
test-suite/tests/numbers.test | 53 +
test-suite/tests/r6rs-base.test | 24 +
test-suite/tests/r6rs-ports.test | 59 +-
test-suite/tests/reader.test | 26 +-
test-suite/tests/srfi-4.test | 83 +-
test-suite/tests/srfi-9.test | 19 +-
test-suite/tests/strings.test | 28 +-
test-suite/tests/symbols.test | 7 +-
test-suite/tests/syncase.test | 21 +-
test-suite/tests/tree-il.test | 13 +-
test-suite/tests/vlist.test | 14 +-
test-suite/vm/t-call-cc.scm | 14 +
190 files changed, 21779 insertions(+), 19094 deletions(-)
delete mode 100644 am/pre-inst-guile
copy module/language/elisp/runtime/value-slot.scm =>
benchmark-suite/benchmarks/r6rs-arithmetic.bm (51%)
create mode 100644 benchmark-suite/benchmarks/strings.bm
create mode 100644 gc-benchmarks/Makefile.am
copy lib/{trunc.c => ceil.c} (90%)
create mode 100644 lib/dosname.h
create mode 100644 lib/frexp.c
copy lib/{isnanl.c => isnand-nolibm.h} (59%)
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
rename meta/{guile-2.0-uninstalled.pc.in => guile-2.2-uninstalled.pc.in} (100%)
rename meta/{guile-2.0.pc.in => guile-2.2.pc.in} (100%)
create mode 100644 module/ice-9/binary-ports.scm
create mode 100644 module/ice-9/eval-string.scm
create mode 100755 test-suite/standalone/test-guile-snarf
copy module/language/elisp/runtime/value-slot.scm =>
test-suite/standalone/test-mb-regexp (56%)
mode change 100644 => 100755
create mode 100644 test-suite/tests/coding.test
create mode 100644 test-suite/tests/eval-string.test
diff --git a/.gitignore b/.gitignore
index f24e589..5d7ed09 100644
--- a/.gitignore
+++ b/.gitignore
@@ -66,8 +66,8 @@ guile-procedures.txt
guile-config/guile-config
*.go
TAGS
-/meta/guile-2.0.pc
-/meta/guile-2.0-uninstalled.pc
+/meta/guile-2.2.pc
+/meta/guile-2.2-uninstalled.pc
gdb-pre-inst-guile
cscope.out
cscope.files
diff --git a/GUILE-VERSION b/GUILE-VERSION
index 7f84c2c..be049f2 100644
--- a/GUILE-VERSION
+++ b/GUILE-VERSION
@@ -5,7 +5,7 @@ GUILE_MAJOR_VERSION=2
GUILE_MINOR_VERSION=1
GUILE_MICRO_VERSION=0
-GUILE_EFFECTIVE_VERSION=2.0
+GUILE_EFFECTIVE_VERSION=2.2
# All of the shared lib versioning info. Right now, for this to work
diff --git a/Makefile.am b/Makefile.am
index 27f7997..3a97683 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/NEWS b/NEWS
index b53386a..206153a 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,21 @@ See the end for copying conditions.
Please send Guile bug reports to address@hidden
+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/README b/README
index 1e9c2f8..256b7d0 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 address@hidden
diff --git a/THANKS b/THANKS
index f912c7b..a06ba4a 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
diff --git a/am/Makefile.am b/am/Makefile.am
index d1b7ecc..e2044d6 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 7993d15..0000000
--- a/am/pre-inst-guile
+++ /dev/null
@@ -1,34 +0,0 @@
-## am/pre-inst-guile --- define preinstguile and preinstguiletool vars
-
-## Copyright (C) 2002, 2006 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 two variables: preinstguile, preinstguiletool.
-## 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
-preinstguiletool = GUILE="$(preinstguile)" $(top_srcdir)/scripts
-
-## am/pre-inst-guile ends here
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index 63f490c..f29743f 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 \
@@ -14,7 +15,8 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/uniform-vector-read.bm \
benchmarks/vectors.bm \
benchmarks/vlists.bm \
- benchmarks/write.bm
+ benchmarks/write.bm \
+ benchmarks/strings.bm
EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \
ChangeLog-2008
diff --git a/benchmark-suite/benchmarks/arithmetic.bm
b/benchmark-suite/benchmarks/arithmetic.bm
index 0755c03..c64f6c2 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))
diff --git a/module/language/elisp/runtime/value-slot.scm
b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
similarity index 51%
copy from module/language/elisp/runtime/value-slot.scm
copy to benchmark-suite/benchmarks/r6rs-arithmetic.bm
index c6cc3b4..4c9b8e6 100644
--- a/module/language/elisp/runtime/value-slot.scm
+++ b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
@@ -1,6 +1,7 @@
-;;; Guile Emacs Lisp
-
-;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;; -*- 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
@@ -13,11 +14,22 @@
;;; 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
+;;; License along with this library. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (benchmarks r6rs-arithmetic)
+ #:use-module (benchmark-suite lib)
+ #:use-module (rnrs arithmetic fixnums))
+
+
+(with-benchmark-prefix "fixnum"
-;;; Code:
+ (benchmark "fixnum? [yes]" 1e7
+ (fixnum? 10000))
-(define-module (language elisp runtime value-slot))
+ (let ((n (+ most-positive-fixnum 100)))
+ (benchmark "fixnum? [no]" 1e7
+ (fixnum? n)))
-;;; This module contains the value-slots of elisp symbols.
+ (benchmark "fxxor [2]" 1e7
+ (fxxor 3 8)))
diff --git a/benchmark-suite/benchmarks/strings.bm
b/benchmark-suite/benchmarks/strings.bm
new file mode 100644
index 0000000..1fcdbd5
--- /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)
+ (string>? str1 str2))
+
+(define (string-ci-op str1 str2)
+ (string-ci<? str1 str2)
+ (string-ci>? str1 str2))
+
+(define (string-fr-op str1 str2)
+ (under-french-locale-or-unresolved
+ (lambda ()
+ (string-locale<? str1 str2 %french-locale)
+ (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)
+ (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)
+ (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)
+ (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))))
+
+
diff --git a/build-aux/config.rpath b/build-aux/config.rpath
index 0e87769..8bd7f5d 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 <address@hidden> 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 68c7d64..686f703 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/configure.ac b/configure.ac
index 5b47701..1b89620 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]),
address@hidden)
AC_CONFIG_AUX_DIR([build-aux])
AC_CONFIG_MACRO_DIR([m4])
@@ -775,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])
@@ -1240,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 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
@@ -1258,6 +1256,13 @@ AC_CHECK_TYPE([GC_fn_type],
[],
[#include <gc/gc.h>])
+# `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 <gc/gc.h>])
+
LIBS="$save_LIBS"
@@ -1489,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")
@@ -1498,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=""
@@ -1568,9 +1573,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)
@@ -1602,6 +1625,7 @@ AC_CONFIG_FILES([
am/Makefile
lib/Makefile
benchmark-suite/Makefile
+ gc-benchmarks/Makefile
doc/Makefile
doc/r5rs/Makefile
doc/ref/Makefile
@@ -1617,8 +1641,8 @@ AC_CONFIG_FILES([
module/Makefile
])
-AC_CONFIG_FILES([meta/guile-2.0.pc])
-AC_CONFIG_FILES([meta/guile-2.0-uninstalled.pc])
+AC_CONFIG_FILES([meta/guile-2.2.pc])
+AC_CONFIG_FILES([meta/guile-2.2-uninstalled.pc])
AC_CONFIG_FILES([doc/ref/effective-version.texi])
GUILE_CONFIG_SCRIPT([check-guile])
diff --git a/doc/example-smob/Makefile b/doc/example-smob/Makefile
index 3736dc0..d368d7b 100644
--- a/doc/example-smob/Makefile
+++ b/doc/example-smob/Makefile
@@ -1,5 +1,5 @@
-CFLAGS = `pkg-config guile-2.0 --cflags`
-LIBS = `pkg-config guile-2.0 --libs`
+CFLAGS = `pkg-config guile-2.2 --cflags`
+LIBS = `pkg-config guile-2.2 --libs`
O_FILES = image-type.o myguile.o
diff --git a/doc/guile.1 b/doc/guile.1
index 2d1fba9..5d8b4e1 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.2"
+.
.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, address@hidden, 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,
address@hidden,
+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 <address@hidden> wrote this manpage.
+Robert Merkel <address@hidden> wrote this manpage.
Rob Browning <address@hidden> 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.
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index c154f42..0359380 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" > "address@hidden"
mv "address@hidden" "$@"
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index e519cab..760039a 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
address@hidden {Scheme Procedure} {} exact-integer-sqrt @var{k}
address@hidden {C Function} void scm_exact_integer_sqrt (SCM @var{k}, SCM
address@hidden, SCM address@hidden)
+Return two exact non-negative integers @var{s} and @var{r}
+such that @address@hidden = @var{s}^2 + @var{r}} and
address@hidden@var{s}^2 <= @var{k} < (@var{s} + 1)^2}.
+An error is raised if @var{k} is not an exact non-negative integer.
+
address@hidden
+(exact-integer-sqrt 10) @result{} 3 and 1
address@hidden lisp
address@hidden deftypefn
+
@node Comparison
@subsubsection Comparison Predicates
@rnindex zero?
@@ -1308,7 +1320,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 +1377,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}.
@@ -4171,8 +4183,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
address@hidden
+interpreted in the character encoding of the current locale.
For @code{scm_from_locale_string}, @var{str} must be null-terminated.
@@ -4201,9 +4212,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
address@hidden eventually, maybe by using @code{scm_dynwind_free},
@xref{Dynamic Wind}.
For @code{scm_to_locale_string}, the returned string is
@@ -4217,13 +4228,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
address@hidden, 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/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index b976715..682e844 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
address@hidden
+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
address@hidden {Scheme Procedure} eval-string string [module]
address@hidden {C Function} scm_eval_string (string)
address@hidden, 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
address@hidden(ice-9 eval-string)}, so load it up:
+
address@hidden
+(use-modules (ice-9 eval-string))
address@hidden example
+
address@hidden {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
address@hidden 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.
address@hidden deffn
+
address@hidden {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)
address@hidden, but taking a C string instead of an
address@hidden
address@hidden, but taking a C string in locale encoding instead
+of an @code{SCM}.
@end deftypefn
@deffn {Scheme Procedure} apply proc arg1 @dots{} argN arglst
@@ -493,9 +522,17 @@ then there's no @address@hidden@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)
address@hidden {C Function} scm_call_5 (proc, arg1, arg2, arg3, arg4, arg5)
address@hidden {C Function} scm_call_6 (proc, arg1, arg2, arg3, arg4, arg5,
arg6)
Call @var{proc} with the given arguments.
@end deffn
address@hidden {C Function} scm_call_n (proc, argv, nargs)
+Call @var{proc} with the array of arguments @var{argv}, as a
address@hidden The length of the arguments should be passed in
address@hidden, as a @code{size_t}.
address@hidden deffn
+
@deffn {Scheme Procedure} apply:nconc2last lst
@deffnx {C Function} scm_nconc2last (lst)
@var{lst} should be a list (@var{arg1} @dots{} @var{argN}
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index fa65d68..2dd6916 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}.
address@hidden 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)'.
address@hidden 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
@@ -360,8 +367,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
address@hidden/usr/lib}, the @code{extensiondir} for the Guile address@hidden
-series will be @file{/usr/lib/guile/2.0/}.
address@hidden/usr/lib}, the @code{extensiondir} for the Guile @address@hidden
+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 +406,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.in >foo.scm
+ sed 's|XXextensiondirXX|$(libdir)/guile/@value{EFFECTIVE-VERSION}|'
<foo.scm.in >foo.scm
@end example
The actual pattern @code{XXextensiondirXX} is arbitrary, it's only something
@@ -561,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.
+
address@hidden {Scheme Procedure} scm->pointer scm
+Return a foreign pointer object with the @code{object-address}
+of @var{scm}.
address@hidden deffn
+
address@hidden {Scheme Procedure} pointer->scm pointer
+Unsafely cast @var{pointer} to a Scheme object.
+Cross your fingers!
address@hidden deffn
+
@node Void Pointers and Byte Access
@subsubsection Void Pointers and Byte Access
@@ -605,20 +626,22 @@ Assuming @var{pointer} points to a memory region that
holds a pointer,
return this pointer.
@end deffn
address@hidden {Scheme Procedure} string->pointer string
address@hidden {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
address@hidden {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.
address@hidden {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
address@hidden, 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/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 52dfdd4..02c1849 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.
@@ -1156,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.
address@hidden: The implementation of this R6RS API is currently far from
-complete, notably due to the lack of support for Unicode I/O and strings.
address@hidden: The implementation of this R6RS API is not complete yet.
@menu
* R6RS End-of-File:: The end-of-file object.
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index e0c10ae..3feced4 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007,
2008, 2009, 2010
address@hidden 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
address@hidden SCM scm_public_variable (SCM @var{module_name}, SCM @var{name})
address@hidden 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
address@hidden is not bound in the module, just returns @code{#f}.
address@hidden deftypefn
+
address@hidden SCM scm_private_variable (SCM @var{module_name}, SCM @var{name})
address@hidden 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.
address@hidden deftypefn
+
address@hidden SCM scm_public_lookup (SCM @var{module_name}, SCM @var{name})
address@hidden SCM scm_c_public_lookup (const char * @var{module_name}, const
char * @var{name})
address@hidden SCM scm_private_lookup (SCM @var{module_name}, SCM @var{name})
address@hidden 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.
+
address@hidden
+SCM my_eval_string (SCM str)
address@hidden
+ 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);
address@hidden
address@hidden example
address@hidden deftypefn
+
address@hidden SCM scm_public_ref (SCM @var{module_name}, SCM @var{name})
address@hidden SCM scm_c_public_ref (const char * @var{module_name}, const char
* @var{name})
address@hidden SCM scm_private_ref (SCM @var{module_name}, SCM @var{name})
address@hidden 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
address@hidden
address@hidden 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 address@hidden)
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
address@hidden {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.
address@hidden deftypefn
+
+To define a value, use @code{scm_define}:
+
@deftypefn {C Procedure} SCM scm_c_define (const char address@hidden, 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
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index 4813864..6f7568b 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
address@hidden 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
address@hidden 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/api-procedures.texi b/doc/ref/api-procedures.texi
index 02889c4..5c6d380 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009,
2010
address@hidden 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
address@hidden Inlinable Procedures
address@hidden Inlinable Procedures
+
+You can define an @dfn{inlinable procedure} by using
address@hidden 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.
+
address@hidden {Scheme Syntax} define-inlinable (name parameter ...) body ...
+Define @var{name} as a procedure with parameters @var{parameter}s and
+body @var{body}.
address@hidden deffn
@c Local Variables:
@c TeX-master: "guile.texi"
diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi
index 1e334c0..6edee54 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009
address@hidden 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
address@hidden to set the vars @code{GUILE_CFLAGS} and
address@hidden, which are automatically substituted in the Makefile.
@example
In configure.ac:
- GUILE_FLAGS
+ PKG_CHECK_MODULES([GUILE], address@hidden)
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/goops.texi b/doc/ref/goops.texi
index 452c88b..362a6e3 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{<complex>}; @code{<complex>} is
the
superclass of @code{<real>}, and @code{<real>} is the superclass of
@code{<integer>}.}
-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.
+
address@hidden {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
address@hidden<class>}. 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}).
address@hidden deffn
+
address@hidden {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
address@hidden as the class name.
address@hidden deffn
@node Instance Creation
@@ -1756,7 +1775,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
@@ -1775,24 +1794,21 @@ 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::
+* Instance Creation Protocol::
+* Class Definition Protocol::
* Customizing Class Definition::
-* Customizing Instance Creation::
-* Class Redefinition::
* Method Definition::
* Method Definition Internals::
* Generic Function Internals::
@@ -1826,7 +1842,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.
@@ -1852,7 +1868,7 @@ superclasses, slot definitions and class options that
were specified in
the @code{define-class} form.
@item
address@hidden allocates memory for the new instance, and then invokes the
address@hidden allocates memory for the new instance, and invokes the
@code{initialize} generic function to initialize the new instance's
slots.
@@ -1863,8 +1879,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{<class>}.
+default behaviour of class definition is encapsulated by generic
+function methods that are specialized for the class @code{<class>}.
It is possible to create a new class that inherits from @code{<class>},
which is called a ``metaclass'', and to write a new @code{initialize}
@@ -1895,19 +1911,8 @@ Each following section covers a particular area of GOOPS
functionality,
and describes the generic functions that are relevant for customization
of that area.
address@hidden Terminology
address@hidden 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.
-
address@hidden Metaclass
address@hidden Metaclasses
address@hidden 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.
@@ -1923,30 +1928,29 @@ at what happens when a new class is created using
@code{define-class}:
(define-class <my-class> (<object>) . slots)
@end example
-GOOPS actually expands the @code{define-class} form to something like
-this
address@hidden
+Guile expands this to something like:
@example
(define <my-class> (class (<object>) . slots))
@end example
-and thence to
address@hidden
+which in turn expands to:
@example
(define <my-class>
(make <class> #:supers (list <object>) #:slots slots))
@end example
-In other words, the value of @code{<my-class>} is in fact an instance of
-the class @code{<class>} with slot values specifying the superclasses
-and slot definitions for the class @code{<my-class>}. (@code{#:supers}
-and @code{#:slots} are initialization keywords for the @code{dsupers}
-and @code{dslots} slots of the @code{<class>} class.)
+As this expansion makes clear, the resulting value of @code{<my-class>}
+is an instance of the class @code{<class>} with slot values specifying
+the superclasses and slot definitions for the class @code{<my-class>}.
+(@code{#:supers} and @code{#:slots} are initialization keywords for the
address@hidden and @code{dslots} slots of the @code{<class>} 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
address@hidden<class>}. This is done by writing:
+Now suppose that you want to define a new class with a metaclass other
+than the default @code{<class>}. This is done by writing:
@example
(define-class <my-class2> (<object>)
@@ -1954,7 +1958,8 @@ create a new class with a metaclass other than the default
#:metaclass <my-metaclass>)
@end example
-GOOPS expands this to something like:
address@hidden
+and Guile expands @emph{this} to something like:
@example
(define <my-class2>
@@ -1991,91 +1996,12 @@ relationships between @code{my-object},
@code{<my-class2>},
The class of @code{my-object} is @code{<my-class2>}.
@item
-The metaclass of @code{my-object} is @code{<my-metaclass>}.
-
address@hidden
The class of @code{<my-class2>} is @code{<my-metaclass>}.
@item
-The metaclass of @code{<my-class2>} is @code{<class>}.
-
address@hidden
The class of @code{<my-metaclass>} is @code{<class>}.
-
address@hidden
-The metaclass of @code{<my-metaclass>} is @code{<class>}.
-
address@hidden
address@hidden<my-class2>} is not a metaclass, since it is does not inherit from
address@hidden<class>}.
-
address@hidden
address@hidden<my-metaclass>} is a metaclass, since it inherits from
address@hidden<class>}.
@end itemize
address@hidden 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{<top>}.
-
-For example, given this inheritance hierarchy:
-
address@hidden
-(define-class <invertebrate> (<object>) @dots{})
-(define-class <echinoderm> (<invertebrate>) @dots{})
-(define-class <starfish> (<echinoderm>) @dots{})
address@hidden example
-
-the class precedence list of <starfish> would be
-
address@hidden
-(<starfish> <echinoderm> <invertebrate> <object> <top>)
address@hidden 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}.
-
address@hidden Accessor
-
-An @dfn{accessor} is a generic function with both reference and setter
-methods.
-
address@hidden
-(define-accessor perimeter)
address@hidden example
-
-Reference methods for an accessor are defined in the same way as generic
-function methods.
-
address@hidden
-(define-method (perimeter (s <square>))
- (* 4 (side-length s)))
address@hidden example
-
-Setter methods for an accessor are defined by specifying ``(setter
-<accessor-name>)'' as the first parameter of the @code{define-method}
-call.
-
address@hidden
-(define-method ((setter perimeter) (s <square>) (n <number>))
- (set! (side-length s) (/ n 4)))
address@hidden example
-
-Once an appropriate setter method has been defined in this way, it can
-be invoked using the generalized @code{set!} syntax, as in:
-
address@hidden
-(set! (perimeter s1) 18.3)
address@hidden example
@node MOP Specification
@subsection MOP Specification
@@ -2085,22 +2011,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
address@hidden(initialize @var{instance} @var{initargs})} invocation in the
+default @code{make-instance} method is customizable, because the type of
+the @address@hidden argument is determined by the class that was
+passed to @code{make-instance}.
address@hidden @bullet
address@hidden
-the @code{(initialize @var{instance} @var{initargs})} invocation in the
-default @code{make-instance} method is customizable, because the type of the
address@hidden@var{instance}} argument is determined by the class that was
passed to
address@hidden
-
address@hidden
-the @code{(make <generic> #:name ',name)} invocation in @code{define-generic}
-is not customizable, because all of its arguments have lexically determined
-types.
address@hidden itemize
+(Whereas --- to give a counter-example --- the @code{(make <generic>
+#: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
@@ -2121,140 +2042,174 @@ effects
what the caller expects to get as the applied method's return value.
@end itemize
address@hidden Class Definition Internals
address@hidden Class Definition Internals
address@hidden (syntax)
address@hidden Instance Creation Protocol
address@hidden Instance Creation Protocol
+
address@hidden <class> . @var{initargs}} (method)
@itemize @bullet
@item
address@hidden (syntax)
address@hidden @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.
address@hidden @bullet
@item
address@hidden (procedure)
address@hidden @var{instance} @var{initargs}} (generic)
+
address@hidden is the uninitialized instance returned by
address@hidden The applied method should initialize the new
+instance in whatever sense is appropriate for its class. The method's
+return value is ignored.
address@hidden itemize
+
address@hidden 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{<class>}, by
+defining a @code{make} method that is specialized to that metaclass.
+
+Normally, however, the method for classes with metaclass @code{<class>}
+will be applied. This method calls two generic functions:
@itemize @bullet
@item
address@hidden @var{metaclass} @dots{}} (generic)
+(allocate-instance @var{class} . @var{initargs})
address@hidden is the metaclass of the class being defined, either
-taken from the @code{#:metaclass} class option or computed by
address@hidden The applied method must create and return the
-fully initialized class metaobject for the new class definition.
address@hidden
+(initialize @var{instance} . @var{initargs})
@end itemize
address@hidden itemize
address@hidden 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
address@hidden, so that GOOPS knows how to make classes from the
+other system, access instance slots, and so on.
+
address@hidden initializes the instance that is returned by
address@hidden The standard GOOPS methods perform
+initializations appropriate to the instance class.
+
address@hidden @bullet
address@hidden
+At the least specialized level, the method for instances of type
address@hidden<object>} 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
address@hidden @var{old-class} @var{new-class}} (generic)
+The method for instances of type @code{<class>} calls
address@hidden(next-method)}, then performs the class initializations described
+in @ref{Class Definition Protocol}.
address@hidden calls @code{class-redefinition} if the variable
-specified by its first argument already held a GOOPS class definition.
address@hidden 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}.
address@hidden
+and so on for generic functions, methods, operator classes @dots{}
@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{<class>}.
+Similarly, you can customize the initialization of instances of any
+application-defined class by defining an @code{initialize} method
+specialized to that class.
address@hidden <class> @var{initargs}} (method)
+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
address@hidden method for the class that queries the database once
+and initializes all the dependent slot values according to the results.
+
+
address@hidden Class Definition Protocol
address@hidden Class Definition Protocol
+
+Here is a summary diagram of the syntax, procedures and generic
+functions that may be involved in class definition.
+
address@hidden
address@hidden (syntax)
@itemize @bullet
@item
address@hidden @var{class}} (generic)
address@hidden (syntax)
-The applied method should compute and return the class precedence list
-for @var{class} as a list of class metaobjects. When @code{compute-cpl}
-is called, the following @var{class} metaobject slots have all been
-initialized: @code{name}, @code{direct-supers}, @code{direct-slots},
address@hidden (empty), @code{direct-methods}. The value
-returned by @code{compute-cpl} will be stored in the @code{cpl} slot.
address@hidden @bullet
address@hidden
address@hidden (procedure)
address@hidden @bullet
@item
address@hidden @var{class}} (generic)
address@hidden (procedure)
-The applied method should compute and return the slots (union of direct
-and inherited) for @var{class} as a list of slot definitions. When
address@hidden is called, all the @var{class} metaobject slots
-mentioned for @code{compute-cpl} have been initialized, plus the
-following: @code{cpl}, @code{redefined} (@code{#f}), @code{environment}.
-The value returned by @code{compute-slots} will be stored in the
address@hidden slot.
address@hidden
address@hidden @var{metaclass} @dots{}} (generic)
address@hidden @bullet
@item
address@hidden @var{class} @var{slot-def}} (generic)
address@hidden (generic)
address@hidden calls @code{compute-get-n-set} for each slot computed
-by @code{compute-slots}. The applied method should compute and return a
-pair of closures that, respectively, get and set the value of the specified
-slot. The get closure should have arity 1 and expect a single argument
-that is the instance whose slot value is to be retrieved. The set closure
-should have arity 2 and expect two arguments, where the first argument is
-the instance whose slot value is to be set and the second argument is the
-new value for that slot. The closures should be returned in a two element
-list: @code{(list @var{get} @var{set})}.
address@hidden
address@hidden (generic)
-The closures returned by @code{compute-get-n-set} are stored as part of
-the value of the @var{class} metaobject's @code{getters-n-setters} slot.
-Specifically, the value of this slot is a list with the same number of
-elements as there are slots in the class, and each element looks either like
address@hidden @bullet
address@hidden
address@hidden (generic)
address@hidden
address@hidden(@var{slot-name-symbol} @var{init-function} . @var{index})}
address@hidden example
address@hidden @bullet
address@hidden
address@hidden (procedure)
address@hidden itemize
-or like
address@hidden
address@hidden (generic)
address@hidden
address@hidden(@var{slot-name-symbol} @var{init-function} @var{get} @var{set})}
address@hidden example
address@hidden
address@hidden (generic)
-Where the get and set closures are replaced by @var{index}, the slot is
-an instance slot and @var{index} is the slot's index in the underlying
-structure: GOOPS knows how to get and set the value of such slots and so
-does not need specially constructed get and set closures. Otherwise,
address@hidden and @var{set} are the closures returned by
@code{compute-get-n-set}.
address@hidden
address@hidden (generic)
-The structure of the @code{getters-n-setters} slot value is important when
-understanding the next customizable generic functions that @code{initialize}
address@hidden
address@hidden
address@hidden (generic)
address@hidden itemize
address@hidden itemize
address@hidden itemize
address@hidden itemize
@item
address@hidden @var{class} @var{gns}} (generic)
address@hidden (generic)
address@hidden calls @code{compute-getter-method} for each of the class's
-slots (as determined by @code{compute-slots}) that includes a
address@hidden: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. ]
address@hidden uses @code{add-method!} to add the returned method to
-the generic function named by the slot definition's @code{#:getter} or
address@hidden:accessor} option.
address@hidden @bullet
address@hidden
address@hidden (generic)
@item
address@hidden @var{class} @var{gns}} (generic)
address@hidden (generic)
address@hidden is invoked with the same arguments as
address@hidden, for each of the class's slots that includes
-a @code{#:setter} or @code{#:accessor} slot option. The applied method
-should create and return a method that is specialized for instances of
-type @var{class} and uses the set closure to set the slot's value.
address@hidden then uses @code{add-method!} to add the returned method
-to the generic function named by the slot definition's @code{#:setter}
-or @code{#:accessor} option.
address@hidden
address@hidden (generic)
@end itemize
address@hidden 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
address@hidden, then @code{compute-cpl} will not be called when a
+class is defined with that metaclass.
address@hidden expands to an expression which
+A @code{(define-class ...)} form (@pxref{Class Definition}) expands to
+an expression which
@itemize @bullet
@item
@@ -2264,8 +2219,7 @@ checks that it is being evaluated only at top level
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})
+uses @code{class} to create the new class
@item
checks for a previous class definition for @var{name} and, if found,
@@ -2316,8 +2270,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
address@hidden)} respectively (@pxref{Class Definition Internals,,
-ensure-metaclass})
address@hidden)} respectively
@item
checks for duplicate classes in @var{supers} and duplicate slot names in
@@ -2353,55 +2306,113 @@ has to be created once.
The @code{env} parameter is ignored.
@end deffn
address@hidden procedure ensure-metaclass-with-supers meta-supers
address@hidden is an internal procedure used by
address@hidden (@pxref{Class Definition Internals,,
-ensure-metaclass}). It returns a metaclass that is the union by
-inheritance of the metaclasses in @var{meta-supers}.
address@hidden generic make metaclass @dots{}
address@hidden is the metaclass of the class being defined, either
+taken from the @code{#:metaclass} class option or computed by
address@hidden The applied method must create and return the
+fully initialized class metaobject for the new class definition.
@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.
+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{<class>}.
address@hidden Customizing Class Definition
address@hidden 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
+The @code{initialize} method for classes (signature @code{(initialize
+<class> initargs)}) calls the following generic functions.
@itemize @bullet
@item
-(initialize @var{class} @dots{})
address@hidden itemize
address@hidden @var{class}} (generic)
-where @var{class} is the newly allocated class instance, and the default
address@hidden method for arguments of type @code{<class>} calls the
-generic functions
+The applied method should compute and return the class precedence list
+for @var{class} as a list of class metaobjects. When @code{compute-cpl}
+is called, the following @var{class} metaobject slots have all been
+initialized: @code{name}, @code{direct-supers}, @code{direct-slots},
address@hidden (empty), @code{direct-methods}. The value
+returned by @code{compute-cpl} will be stored in the @code{cpl} slot.
address@hidden @bullet
@item
-(compute-cpl @var{class})
address@hidden @var{class}} (generic)
address@hidden
-(compute-slots @var{class})
+The applied method should compute and return the slots (union of direct
+and inherited) for @var{class} as a list of slot definitions. When
address@hidden is called, all the @var{class} metaobject slots
+mentioned for @code{compute-cpl} have been initialized, plus the
+following: @code{cpl}, @code{redefined} (@code{#f}), @code{environment}.
+The value returned by @code{compute-slots} will be stored in the
address@hidden slot.
@item
-(compute-get-n-set @var{class} @var{slot-def}), for each of the slot
-definitions returned by @code{compute-slots}
address@hidden @var{class} @var{slot-def}} (generic)
+
address@hidden calls @code{compute-get-n-set} for each slot computed
+by @code{compute-slots}. The applied method should compute and return a
+pair of closures that, respectively, get and set the value of the specified
+slot. The get closure should have arity 1 and expect a single argument
+that is the instance whose slot value is to be retrieved. The set closure
+should have arity 2 and expect two arguments, where the first argument is
+the instance whose slot value is to be set and the second argument is the
+new value for that slot. The closures should be returned in a two element
+list: @code{(list @var{get} @var{set})}.
+
+The closures returned by @code{compute-get-n-set} are stored as part of
+the value of the @var{class} metaobject's @code{getters-n-setters} slot.
+Specifically, the value of this slot is a list with the same number of
+elements as there are slots in the class, and each element looks either like
+
address@hidden
address@hidden(@var{slot-name-symbol} @var{init-function} . @var{index})}
address@hidden example
+
+or like
+
address@hidden
address@hidden(@var{slot-name-symbol} @var{init-function} @var{get} @var{set})}
address@hidden example
+
+Where the get and set closures are replaced by @var{index}, the slot is
+an instance slot and @var{index} is the slot's index in the underlying
+structure: GOOPS knows how to get and set the value of such slots and so
+does not need specially constructed get and set closures. Otherwise,
address@hidden and @var{set} are the closures returned by
@code{compute-get-n-set}.
+
+The structure of the @code{getters-n-setters} slot value is important when
+understanding the next customizable generic functions that @code{initialize}
address@hidden
@item
-(compute-getter-method @var{class} @var{slot-def}), for each of the
-slot definitions returned by @code{compute-slots} that includes a
address@hidden:getter} or @code{#:accessor} slot option
address@hidden @var{class} @var{gns}} (generic)
+
address@hidden calls @code{compute-getter-method} for each of the
+class's slots (as determined by @code{compute-slots}) that includes a
address@hidden: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.
address@hidden uses @code{add-method!} to add the returned method to
+the generic function named by the slot definition's @code{#:getter} or
address@hidden:accessor} option.
@item
-(compute-setter-method @var{class} @var{slot-def}), for each of the
-slot definitions returned by @code{compute-slots} that includes a
address@hidden:setter} or @code{#:accessor} slot option.
address@hidden @var{class} @var{gns}} (generic)
+
address@hidden is invoked with the same arguments as
address@hidden, for each of the class's slots that includes
+a @code{#:setter} or @code{#:accessor} slot option. The applied method
+should create and return a method that is specialized for instances of
+type @var{class} and uses the set closure to set the slot's value.
address@hidden then uses @code{add-method!} to add the returned method
+to the generic function named by the slot definition's @code{#:setter}
+or @code{#:accessor} option.
@end itemize
address@hidden Customizing Class Definition
address@hidden Customizing Class Definition
+
If the metaclass of the new class is something more specialized than the
default @code{<class>}, then the type of @var{class} in the calls above
is more specialized than @code{<class>}, and hence it becomes possible
@@ -2419,8 +2430,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
@@ -2489,7 +2499,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
@@ -2500,152 +2510,6 @@ 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.
address@hidden Customizing Instance Creation
address@hidden Customizing Instance Creation
-
address@hidden <class> . @var{initargs}} (method)
-
address@hidden @bullet
address@hidden
address@hidden @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.
-
address@hidden
address@hidden @var{instance} @var{initargs}} (generic)
-
address@hidden is the uninitialized instance returned by
address@hidden The applied method should initialize the new
-instance in whatever sense is appropriate for its class. The method's
-return value is ignored.
address@hidden itemize
-
address@hidden 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{<class>}, by
-defining a @code{make} method that is specialized to that metaclass.
-
-Normally, however, the method for classes with metaclass @code{<class>}
-will be applied. This method calls two generic functions:
-
address@hidden @bullet
address@hidden
-(allocate-instance @var{class} . @var{initargs})
-
address@hidden
-(initialize @var{instance} . @var{initargs})
address@hidden itemize
-
address@hidden 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
address@hidden, so that GOOPS knows how to make classes from the
-other system, access instance slots, and so on.
-
address@hidden initializes the instance that is returned by
address@hidden The standard GOOPS methods perform
-initializations appropriate to the instance class.
-
address@hidden @bullet
address@hidden
-At the least specialized level, the method for instances of type
address@hidden<object>} 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}.
-
address@hidden
-The method for instances of type @code{<class>} calls
address@hidden(next-method)}, then performs the class initializations described
-in @ref{Customizing Class Definition}.
-
address@hidden
-and so on for generic functions, method, operator classes @dots{}
address@hidden 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
address@hidden method for the class that queries the database once
-and initializes all the dependent slot values according to the results.
-
address@hidden Class Redefinition
address@hidden Class Redefinition
-
-The default @code{class-redefinition} method, specialized for classes
-with the default metaclass @code{<class>}, has the following internal
-protocol.
-
address@hidden (@var{old <class>}) (@var{new <class>})}
-(method)
-
address@hidden @bullet
address@hidden
address@hidden @var{old}} (generic)
-
address@hidden
address@hidden @var{method} @var{old} @var{new}} (generic)
-
address@hidden
address@hidden @var{subclass} @var{old} @var{new}} (generic)
address@hidden 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
address@hidden 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
address@hidden the Class of an Instance}. After doing so, it makes a
-generic function invocation that can be used to customize the instance
-update algorithm.
-
address@hidden (@var{old-instance <object>}) (@var{new <class>})} (method)
-
address@hidden @bullet
address@hidden
address@hidden @var{old-instance} @var{new-instance}} (generic)
-
address@hidden 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.
address@hidden itemize
@node Method Definition
@subsection Method Definition
@@ -2655,7 +2519,9 @@ nothing.
@itemize @bullet
@item
@code{add-method! @var{target} @var{method}} (generic)
address@hidden itemize
address@hidden
@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
@@ -2673,12 +2539,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.
address@hidden itemize
+
@node Method Definition Internals
@subsection Method Definition Internals
address@hidden
address@hidden:
@itemize @bullet
@item
@@ -2708,7 +2574,8 @@ The @var{parameter} and @var{body} parameters should be
as for
define-method}).
@end deffn
address@hidden
address@hidden
address@hidden:
@itemize @bullet
@item
@@ -2734,6 +2601,7 @@ parameter combinations to which this method will be
applicable.
function parameters when this method is invoked.
@end deffn
address@hidden
@code{make-method} is a simple wrapper around @code{make} with metaclass
@code{<method>}.
@@ -2834,71 +2702,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.
address@hidden
address@hidden
address@hidden (generic)
@itemize @bullet
@item
address@hidden
address@hidden (generic)
@item
address@hidden
address@hidden (generic)
@item
address@hidden
-
address@hidden
address@hidden
address@hidden (generic)
address@hidden @bullet
@item
address@hidden
address@hidden (generic)
@end itemize
address@hidden
address@hidden
address@hidden (generic)
@itemize @bullet
@item
address@hidden
address@hidden itemize
address@hidden (generic)
address@hidden
-
address@hidden @bullet
@item
address@hidden
address@hidden (generic)
@end itemize
address@hidden
-
address@hidden @bullet
@item
address@hidden
address@hidden
@end itemize
-
address@hidden Class Options
address@hidden Class Options
-
address@hidden {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
address@hidden<class>}. For the use of metaclasses, see @ref{Metaobjects and
-the Metaobject Protocol} and @ref{Terminology}.
-
-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}).
address@hidden deffn
-
address@hidden {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
address@hidden as the class name.
address@hidden deffn
+We do not yet have full documentation for these. Please refer to the
+code (@file{oop/goops.scm}) for details.
@node Redefining a Class
@@ -2972,8 +2816,8 @@ be address@hidden
@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>}, class redefinition behaviour can
@@ -2992,6 +2836,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{<class>}, calls the following generic functions,
+which could of course be individually customized.
+
address@hidden 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.
address@hidden deffn
+
address@hidden 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.
address@hidden deffn
+
address@hidden generic update-direct-subclass! subclass old new
+The default @code{update-direct-subclass!} method invokes
address@hidden recursively to handle the redefinition of
+subclasses.
address@hidden 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
@@ -3015,34 +2879,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:
-
address@hidden @bullet
address@hidden
-(remove-class-accessors! @var{old-class})
-
address@hidden
-(update-direct-method! @var{method} @var{old-class} @var{new-class})
-
address@hidden
-(update-direct-subclass! @var{subclass} @var{old-class} @var{new-class})
address@hidden itemize
-
-and the default methods for these generic functions invoke further
-generic functions, and so address@hidden 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}.
address@hidden generic change-class
address@hidden 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
@@ -3053,6 +2901,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}).
address@hidden generic change-class instance new-class
address@hidden deffn
+
@deffn {method} change-class (obj <object>) (new <class>)
Modify instance @var{obj} to make it an instance of class @var{new}.
@@ -3064,11 +2915,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
address@hidden 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.
+
address@hidden 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
address@hidden method does nothing.
address@hidden 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.
diff --git a/doc/ref/history.texi b/doc/ref/history.texi
index 62b637d..970ec01 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.
address@hidden Copyright (C) 2008, 2010
address@hidden 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.
address@hidden 2.0 --- April 2010
address@hidden 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-concepts.texi b/doc/ref/libguile-concepts.texi
index 6ebeb63..915054c 100644
--- a/doc/ref/libguile-concepts.texi
+++ b/doc/ref/libguile-concepts.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2010
address@hidden 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.
@@ -449,16 +449,18 @@ that are stored in local variables. When a thread puts
itself into
guile mode for the first time, it gets a Scheme representation and is
listed by @code{all-threads}, for example.
-Threads in guile mode can block (e.g., do blocking I/O) without causing any
address@hidden Guile 1.8, a thread blocking in guile mode would prevent
-garbage collection to occur. Thus, threads had to leave guile mode whenever
-they could block. This is no longer needed with Guile 2.0.}; temporarily
-leaving guile mode with @code{scm_without_guile} before blocking slightly
-improves GC performance, though. For some common blocking operations, Guile
-provides convenience functions. For example, if you want to lock a pthread
-mutex while in guile mode, you might want to use @code{scm_pthread_mutex_lock}
-which is just like @code{pthread_mutex_lock} except that it leaves guile mode
-while blocking.
+Threads in guile mode can block (e.g., do blocking I/O) without causing
+any address@hidden Guile 1.8, a thread blocking in guile mode
+would prevent garbage collection to occur. Thus, threads had to leave
+guile mode whenever they could block. This is no longer needed with
+Guile address@hidden; temporarily leaving guile mode with
address@hidden before blocking slightly improves GC
+performance, though. For some common blocking operations, Guile
+provides convenience functions. For example, if you want to lock a
+pthread mutex while in guile mode, you might want to use
address@hidden which is just like
address@hidden except that it leaves guile mode while
+blocking.
All libguile functions are (intended to be) robust in the face of
diff --git a/doc/ref/libguile-extensions.texi b/doc/ref/libguile-extensions.texi
index 78871c6..95f92ca 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2006
address@hidden 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
@@ -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 address@hidden \
+ -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/libguile-linking.texi b/doc/ref/libguile-linking.texi
index b6a8855..3a90208 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2010
address@hidden 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
address@hidden during the configuration phase of your program and
address@hidden<libguile.h>} 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{<libguile.h>}, or links to
address@hidden, 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
address@hidden, for example, you would invoke
address@hidden --cflags --libs address@hidden to get
+the compilation and linking flags necessary to link to version
address@hidden of Guile. You would typically run
address@hidden 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 <libguile.h>
-CFLAGS=`guile-config compile`
+CFLAGS=`pkg-config --cflags address@hidden
# Tell the linker what libraries to use and where to find them.
-LIBS=`guile-config link`
+LIBS=`pkg-config --libs address@hidden
simple-guile: simple-guile.o
address@hidden@} simple-guile.o address@hidden@} -o simple-guile
@@ -120,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
address@hidden 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
address@hidden that uses the standard @code{PKG_CHECK_MODULES}
+macro to check for Guile. Autoconf will process this file into a
address@hidden script. We recommend invoking Autoconf via the
address@hidden utility.
@example
AC_INIT(simple-guile.c)
@@ -135,19 +141,21 @@ AC_INIT(simple-guile.c)
AC_PROG_CC
# Check for Guile
-GUILE_FLAGS
+PKG_CHECK_MODULES([GUILE], address@hidden)
# 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
address@hidden@} simple-guile.o address@hidden@} -o simple-guile
@@ -156,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
diff --git a/doc/ref/libguile-smobs.texi b/doc/ref/libguile-smobs.texi
index c6581a1..eb938f0 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2010
address@hidden 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 address@hidden -c image-type.c -o image-type.o
+gcc `pkg-config --cflags address@hidden -c myguile.c -o myguile.o
+gcc image-type.o myguile.o `pkg-config --libs address@hidden -o myguile
zwingli:example-smob$ ./myguile
guile> make-image
#<primitive-procedure make-image>
diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi
index 72a3f34..bc569ed 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:
-
address@hidden
-(let ()
- (define even?
- (lambda (x)
- (or (= x 0) (odd? (- x 1)))))
- (define-syntax odd?
- (syntax-rules ()
- ((odd? x) (not (even? x)))))
- (even? 10))
address@hidden #t
address@hidden example
-
address@hidden
-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))
address@hidden #t
address@hidden example
+
address@hidden
+The same definitions outside of the @code{begin} wrapper do not:
+
address@hidden
+(define even?
+ (lambda (x)
+ (or (= x 0) (odd? (- x 1)))))
+(define-syntax odd?
+ (syntax-rules ()
+ ((odd? x) (not (even? x)))))
+(even? 10)
<unnamed port>:4:18: In procedure even?:
<unnamed port>:4:18: Wrong type to apply: #<syntax-transformer odd?>
@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
@@ -378,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 ...
address@hidden {Scheme Procedure} exact-integer-sqrt k
@xref{Integer Operations}, for documentation.
@end deffn
@@ -524,11 +526,6 @@ This is a consequence of the requirement that
@end lisp
@end deffn
address@hidden {Scheme Procedure} exact-integer-sqrt k
-This procedure returns two nonnegative integer objects @code{s} and
address@hidden such that k = s^2 + r and k < (s + 1)^2.
address@hidden deffn
-
@deffn {Scheme Procedure} real-valued? obj
@deffnx {Scheme Procedure} rational-valued? obj
@deffnx {Scheme Procedure} integer-valued? obj
diff --git a/doc/ref/scheme-scripts.texi b/doc/ref/scheme-scripts.texi
index 5a6f494..0ad1bec 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.
address@hidden -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 address@hidden
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 126b845..7995c8c 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.
address@hidden Copyright (C) 2006, 2010
address@hidden 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
address@hidden Init File
address@hidden The Init File, @file{~/.guile}
+
address@hidden .guile
+When run interactively, Guile will load a local initialization file from
address@hidden/.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
address@hidden@@(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
address@hidden@@(guile-user)>} prompt.
address@hidden@@(guile-user)>} prompts) in your @file{.guile} file.
address@hidden File}, for more on @file{.guile}.
@node Value History
@@ -337,6 +352,12 @@ Show the VM registers associated with the current frame.
@xref{Stack Layout}, for more information on VM stack frames.
@end deffn
address@hidden {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.
address@hidden deffn
+
The next 3 commands work at any REPL.
@deffn {REPL Command} break proc
@@ -404,6 +425,35 @@ List/show/set options.
Quit this session.
@end deffn
+Current REPL options include:
+
address@hidden @code
address@hidden compile-options
+The options used when compiling expressions entered at the REPL.
address@hidden, for more on compilation options.
address@hidden interp
+Whether to interpret or compile expressions given at the REPL, if such a
+choice is available. Off by default (indicating compilation).
address@hidden prompt
+A customized REPL prompt. @code{#f} by default, indicating the default
+prompt.
address@hidden value-history
+Whether value history is on or not. @xref{Value History}.
address@hidden 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.
address@hidden table
+
+Default values for REPL options may be set using
address@hidden from @code{(system repl common)}:
+
address@hidden {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}.
address@hidden deffn
+
@node Error Handling
@subsection Error Handling
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index bda7cbb..0517fc4 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006,
2007, 2008, 2009, 2010
address@hidden 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.
@@ -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
@@ -170,8 +171,8 @@ how to load it with the Guile mechanism.
@cindex @code{guile-2} SRFI-0 feature
@cindex portability between 2.0 and older versions
Likewise, testing the @code{guile-2} feature allows code to be portable
-between Guile 2.0 and previous versions of Guile. For instance, it
-makes it possible to write code that accounts for Guile 2.0's compiler,
+between Guile address@hidden and previous versions of Guile. For instance, it
+makes it possible to write code that accounts for Guile address@hidden's
compiler,
yet be correctly interpreted on 1.8 and earlier versions:
@example
@@ -1927,6 +1928,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.
address@hidden 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
address@hidden 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
@@ -3128,6 +3136,11 @@ Conversion is locale-dependent on systems that support it
locale.
@end defun
address@hidden SRFI-23
address@hidden SRFI-23 - Error Reporting
address@hidden SRFI-23
+
+The SRFI-23 @code{error} procedure is always available.
@node SRFI-26
@subsection SRFI-26 - specializing parameters
diff --git a/doc/ref/tools.texi b/doc/ref/tools.texi
index 2f4f59a..7a98884 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.
-
address@hidden 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,17 +343,11 @@ 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".
-
address@hidden
-The file must be executable (chmod +x).
-
address@hidden
The module name must be "(scripts PROGRAM)". A procedure named PROGRAM w/
signature "(PROGRAM . args)" must be exported. Basically, use some variant
of the form:
@@ -377,20 +368,10 @@ There must be the alias:
However, `main' must NOT be exported.
address@hidden
-The beginning of the file must use the following invocation sequence:
-
address@hidden
-#!/bin/sh
-main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')'
-exec address@hidden@} -l $0 -c "(apply $main (cdr (command-line)))" "$@@"
-!#
address@hidden example
-
@end itemize
Following these conventions allows the program file to be used as module
address@hidden(scripts PROGRAM)} in addition to as a standalone executable.
Please
address@hidden(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/doc/ref/tour.texi b/doc/ref/tour.texi
index 2215cf0..c6949eb 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006,
2010
address@hidden 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 address@hidden
@end example
When it is run, it behaves just like the @code{guile} program except
@@ -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 address@hidden \
+ -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/vm.texi b/doc/ref/vm.texi
index fa73f9b..cf4e135 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.
address@hidden Copyright (C) 2008, 2009, 2010, 2011
address@hidden Copyright (C) 2008,2009,2010,2011
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -79,9 +79,9 @@ but it is not normally used at runtime.)
The upside of implementing the interpreter in Scheme is that we preserve
tail calls and multiple-value handling between interpreted and compiled
-code. The downside is that the interpreter in Guile 2.0 is slower than
-the interpreter in 1.8. We hope the that the compiler's speed makes up
-for the loss!
+code. The downside is that the interpreter in Guile address@hidden is slower
+than the interpreter in 1.8. We hope the that the compiler's speed makes
+up for the loss!
Also note that this decision to implement a bytecode compiler does not
preclude native compilation. We can compile from bytecode to native
@@ -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
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index c7018e9..46d4cfb 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))
@@ -1331,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{<response>} record from @code{(web
-response)}, and the response body as a string, bytevector, or
address@hidden 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{<response>} 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{<response>}, 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
address@hidden documentation, for more.
@item
The @code{write} hook is called with three arguments: the client
@@ -1581,7 +1582,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
diff --git a/gc-benchmarks/Makefile.am b/gc-benchmarks/Makefile.am
new file mode 100644
index 0000000..0fdbcdc
--- /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
+# <http://www.ccs.neu.edu/home/will/GC/sourcecode.html>.
+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
diff --git a/gc-benchmarks/gc-profile.scm b/gc-benchmarks/gc-profile.scm
index 3365832..d95e295 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,13 +38,18 @@ 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
"^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))
@@ -83,7 +88,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)\\]"))
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 50c3742..5d0c229 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 address@hidden $@
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/trunc.c b/lib/ceil.c
similarity index 90%
copy from lib/trunc.c
copy to lib/ceil.c
index f213b26..e536763 100644
--- a/lib/trunc.c
+++ b/lib/ceil.c
@@ -1,4 +1,4 @@
-/* Round towards zero.
+/* 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
@@ -26,19 +26,19 @@
#undef MIN
#ifdef USE_LONG_DOUBLE
-# define FUNC truncl
+# 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 trunc
+# 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 truncf
+# define FUNC ceilf
# define DOUBLE float
# define MANT_DIG FLT_MANT_DIG
# define MIN FLT_MIN
@@ -77,19 +77,15 @@ FUNC (DOUBLE x)
if (z > L_(0.0))
{
- /* For 0 < x < 1, return +0.0 even if the current rounding mode is
- FE_DOWNWARD. */
- if (z < L_(1.0))
- z = L_(0.0);
/* Avoid rounding errors for values near 2^k, where k >= MANT_DIG-1. */
- else if (z < TWO_MANT_DIG)
+ 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 down. */
- if (z > y)
- z -= L_(1.0);
+ /* Enforce rounding up. */
+ if (z < y)
+ z += L_(1.0);
}
}
else if (z < L_(0.0))
diff --git a/lib/dosname.h b/lib/dosname.h
new file mode 100644
index 0000000..3087d39
--- /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 <http://www.gnu.org/licenses/>.
+
+ 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 bdec6d4..8f018e5 100644
--- a/lib/flock.c
+++ b/lib/flock.c
@@ -27,13 +27,13 @@
#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
/* _get_osfhandle */
-#include <io.h>
+# include <io.h>
/* LockFileEx */
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
-#include <errno.h>
+# include <errno.h>
/* 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 <fcntl.h>
+# include <fcntl.h>
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
+# ifdef HAVE_UNISTD_H
+# include <unistd.h>
+# endif
-#include <errno.h>
-#include <string.h>
+# include <errno.h>
+# include <string.h>
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 0000000..c7687e0
--- /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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paolo Bonzini <address@hidden>, 2003, and
+ Bruno Haible <address@hidden>, 2007. */
+
+#include <config.h>
+
+/* Specification. */
+#include <math.h>
+
+#include <float.h>
+#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/isnanl.c b/lib/isnand-nolibm.h
similarity index 59%
copy from lib/isnanl.c
copy to lib/isnand-nolibm.h
index 2e68d28..e434a7b 100644
--- a/lib/isnanl.c
+++ b/lib/isnand-nolibm.h
@@ -1,5 +1,5 @@
/* Test for NaN that does not need libm.
- Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc.
+ 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
@@ -14,7 +14,20 @@
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
-/* Written by Bruno Haible <address@hidden>, 2007. */
-
-#define USE_LONG_DOUBLE
-#include "isnan.c"
+#if HAVE_ISNAND_IN_LIBC
+/* Get declaration of isnan macro. */
+# include <math.h>
+# 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 1630a6d..0000000
--- 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 <address@hidden>, 2007.
- Based heavily on code by Bruno Haible. */
-
-#include <config.h>
-
-/* Specification. */
-#include <math.h>
-
-#include <float.h>
-
-#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 d154a18..aa369d0 100644
--- a/lib/stat.c
+++ b/lib/stat.c
@@ -37,6 +37,7 @@ orig_stat (const char *filename, struct stat *buf)
#include <limits.h>
#include <stdbool.h>
#include <string.h>
+#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 319b8aa..b60e9cc 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
<wchar.h> -> <stdio.h> -> <getopt.h> -> <stdlib.h>, and the latter includes
<stdint.h> 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: <stddef.h>, <stdio.h> and <time.h> must be
+ included before <wchar.h>. */
+# include <stddef.h>
+# include <stdio.h>
+# include <time.h>
# define _GL_JUST_INCLUDE_SYSTEM_WCHAR_H
# include <wchar.h>
# undef _GL_JUST_INCLUDE_SYSTEM_WCHAR_H
diff --git a/lib/stdio-write.c b/lib/stdio-write.c
deleted file mode 100644
index 252d9bc..0000000
--- 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 <address@hidden>, 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 <http://www.gnu.org/licenses/>. */
-
-#include <config.h>
-
-/* Specification. */
-#include <stdio.h>
-
-/* 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 <errno.h>
-# include <signal.h>
-# include <io.h>
-
-# define WIN32_LEAN_AND_MEAN /* avoid including junk */
-# include <windows.h>
-
-# 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 e2d9457..980b909 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 cad862f..fec68c8 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 7ae03da..e2de468 100644
--- a/lib/vasnprintf.h
+++ b/lib/vasnprintf.h
@@ -24,16 +24,16 @@
/* Get size_t. */
#include <stddef.h>
-#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 9446dec..b197ad1 100644
--- a/lib/version-etc.h
+++ b/lib/version-etc.h
@@ -23,11 +23,11 @@
# include <stdio.h>
/* 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 20c1795..ac27eb8 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -460,7 +460,9 @@ version_info =
@LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGU
address@hidden@_la_LDFLAGS = \
$(BDW_GC_LIBS) $(LIBFFI_LIBS) \
+ $(CEIL_LIBM) \
$(FLOOR_LIBM) \
+ $(FREXP_LIBM) \
$(GETADDRINFO_LIB) \
$(HOSTENT_LIB) \
$(INET_NTOP_LIB) \
@@ -468,12 +470,12 @@ address@hidden@_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/libguile/array-handle.h b/libguile/array-handle.h
index caf9cef..2e8af77 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[];
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 89f5e9d..6724d00 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 c7abe31..db22c17 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);
@@ -431,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;
@@ -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);
@@ -485,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/bdw-gc.h b/libguile/bdw-gc.h
index 3adf99e..61c11eb 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 <gc/gc.h>
diff --git a/libguile/continuations.c b/libguile/continuations.c
index dc6850e..7d56c2a 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/libguile/control.c b/libguile/control.c
index b6a5587..dc3fed2 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 bbc4c20..2167ffa 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/deprecated.c b/libguile/deprecated.c
index fd23e2d..4d6027c 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/dynl.c b/libguile/dynl.c
index 2484dda..a2ae6e2 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/libguile/eval.c b/libguile/eval.c
index 6f2020e..164aadd 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;
}
@@ -477,6 +477,21 @@ scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM
arg4)
}
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)
{
return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
@@ -543,11 +558,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/eval.h b/libguile/eval.h
index 969cce1..f193ad6 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);
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 68d90d9..96752bc 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/foreign.c b/libguile/foreign.c
index 6f008e7..ae9e27a 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"
@@ -327,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);
@@ -341,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
@@ -402,8 +481,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);
}
@@ -861,6 +956,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/libguile/foreign.h b/libguile/foreign.h
index b290019..6c6f373 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/libguile/frames.c b/libguile/frames.c
index bc1bb82..62ba23f 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/gc.c b/libguile/gc.c
index 91250ba..8816a61 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 <unistd.h>
#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;
@@ -206,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. */
@@ -287,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)),
@@ -377,17 +344,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 +544,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 +616,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;
diff --git a/libguile/gdbint.c b/libguile/gdbint.c
index 7cc9535..77fdbd1 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/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 0263356..5834346 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -318,6 +318,24 @@ 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
+
+#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/goops.c b/libguile/goops.c
index c597044..f610208 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/guile-snarf.in b/libguile/guile-snarf.in
index 043b3ed..c73e8ce 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
- grep "^ *\^ *\^" ${temp} | sed -e "s/ *\^ *\^//g" -e "s/\^ *: *\^/;/g"
+ 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/hashtab.c b/libguile/hashtab.c
index f3887c2..a76c038 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"
@@ -120,6 +121,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
@@ -397,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"
@@ -407,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
@@ -422,13 +477,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
@@ -439,16 +498,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
@@ -651,12 +712,9 @@ 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 (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);
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 14dc9b9..fc651fd 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 ();
}
@@ -1113,23 +1107,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))
{
@@ -1256,7 +1246,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);
@@ -1564,11 +1554,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
+
<http://lists.gnu.org/archive/html/bug-guile/2011-02/msg00159.html>). */
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 +1569,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)
diff --git a/libguile/init.c b/libguile/init.c
index 9b8c4d0..8b3b8cd 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"));
}
@@ -386,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 7cfae76..bc6cddf 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/modules.c b/libguile/modules.c
index 40f9c84..e060821 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)
{
@@ -752,6 +755,124 @@ scm_lookup (SCM sym)
}
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)
{
return scm_module_define (module, scm_from_locale_symbol (name), 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 aef7d3b..07dc2c3 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,
diff --git a/libguile/numbers.c b/libguile/numbers.c
index f8891fa..7475381 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". */
@@ -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;
@@ -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)),
@@ -9553,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 @address@hidden = @var{s}^2 + @var{r}} and\n"
+ "@address@hidden <= @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 ab96981..d985830 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/libguile/objcodes.c b/libguile/objcodes.c
index f4e20f8..448bada 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -23,12 +23,18 @@
#include <string.h>
#include <fcntl.h>
#include <unistd.h>
+
+#ifdef HAVE_SYS_MMAN_H
#include <sys/mman.h>
+#endif
+
#include <sys/stat.h>
#include <sys/types.h>
#include <assert.h>
#include <alignof.h>
+#include <full-read.h>
+
#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_SHARED, 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];
-
- 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)));
+ char *addr;
+ struct scm_objcode *data;
+
+ 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
diff --git a/libguile/ports.c b/libguile/ports.c
index b65650e..6e0ae6c 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
@@ -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,
@@ -661,6 +658,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);
@@ -1929,9 +1939,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);
@@ -2099,6 +2108,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;
}
diff --git a/libguile/posix.c b/libguile/posix.c
index 97e30df..a5c7262 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/print.c b/libguile/print.c
index 59b1093..1399566 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,114 @@ quote_keywordish_symbol (SCM symbol)
return 1;
}
-void
-scm_i_print_symbol_name (SCM str, SCM port)
+#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)
{
- /* 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);
-
- 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)))
+ size_t pos, len = scm_i_symbol_length (sym);
+ scm_t_wchar c;
+
+ /* 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 == ',' || 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;
+
+ /* 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++)
{
- scm_lfwrite ("#{", 2, port);
- weird = 1;
+ 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;
}
- for (end = pos; end < len; ++end)
- switch (scm_i_symbol_ref (str, end))
- {
-#ifdef BRACKETS_AS_PARENS
- 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);
+ return 0;
+}
+
+static void
+print_normal_symbol (SCM sym, SCM port)
+{
+ scm_display (scm_symbol_to_string (sym), port);
+}
+
+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);
+
+ if (uc_is_general_category_withtable (c,
+ SUBSEQUENT_IDENTIFIER_MASK
+ | UC_CATEGORY_MASK_Zs))
+ {
+ if (!display_character (c, port, strategy))
+ scm_encoding_error ("print_extended_symbol", errno,
+ "cannot convert to output locale",
+ port, SCM_MAKE_CHAR (c));
+ }
+ else
+ {
+ display_string ("\\x", 1, 2, port, iconveh_question_mark);
+ scm_intprint (c, 16, port);
+ display_character (';', port, iconveh_question_mark);
+ }
+ }
+
+ 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
@@ -862,6 +880,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 +893,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
@@ -1282,8 +1302,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/procs.c b/libguile/procs.c
index 2b7225e..a096591 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/libguile/pthread-threads.h b/libguile/pthread-threads.h
index ca72f16..4c67b18 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,39 @@
#include <pthread.h>
#include <sched.h>
-/* `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_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
/* 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
*/
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 8058ca0..7473db9 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
@@ -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;
@@ -1222,6 +1222,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. */
void
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
index edde005..2ae3e76 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/libguile/read.c b/libguile/read.c
index 5f0be31..4b6828b 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));
}
@@ -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,
@@ -1234,9 +1230,9 @@ 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);
+ SCM buf = scm_i_make_string (1024, NULL, 0);
buf = scm_i_string_start_writing (buf);
@@ -1246,36 +1242,75 @@ 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)
{
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);
}
-
- 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)));
}
@@ -1333,6 +1368,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':
@@ -1352,7 +1388,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':
@@ -1654,6 +1689,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;
@@ -1661,15 +1697,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);
+
+ if (pt->rw_active == SCM_PORT_WRITE)
+ scm_flush (port);
+
+ 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;
- bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);
- header[bytes_read] = '\0';
+ 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;
- scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
+ 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')
@@ -1718,22 +1785,26 @@ scm_i_scan_for_encoding (SCM port)
pos = encoding_start;
while (pos >= header)
{
- if (*pos == '\n')
+ if (*pos == ';')
+ {
+ in_comment = 1;
+ break;
+ }
+ 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)
+ if (beg < encoding_start && encoding_start + encoding_length <= end)
in_comment = 1;
break;
}
- if (*pos == ';')
- {
- in_comment = 1;
- break;
- }
- pos --;
+ else
+ {
+ pos --;
+ continue;
+ }
}
if (!in_comment)
/* This wasn't in a comment */
@@ -1761,6 +1832,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;
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 9bb998e..7d22a36 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/libguile/socket.c b/libguile/socket.c
index 1059708..632dd4f 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 ab933c2..5bba81c 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)
@@ -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;
@@ -2484,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)
{
@@ -2622,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);
@@ -2634,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 ();
@@ -2688,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);
@@ -2700,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 ();
@@ -2815,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;
@@ -3127,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
@@ -3237,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
@@ -3279,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 b22471d..e2f6668 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/stacks.c b/libguile/stacks.c
index 267b3c4..31bd91b 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. */
diff --git a/libguile/strings.c b/libguile/strings.c
index b13cb78..bf63704 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))
{
@@ -1419,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));
@@ -1432,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));
@@ -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;
}
@@ -1528,25 +1532,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
@@ -1565,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;
@@ -1598,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);
@@ -1771,21 +1758,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));
}
@@ -2029,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);
@@ -2241,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 ed3a067..b1fc51a 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 625b753..b7fec47 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
@@ -30,7 +30,7 @@
#include <unistd.h>
#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);
@@ -138,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)
{
@@ -255,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)
@@ -289,16 +266,19 @@ 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)
{
- 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 +288,44 @@ 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));
- 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 (str_len, "strport");
- memcpy (c_str, buf, str_len);
- free (buf);
+ 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);
+
+ /* 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;
+
+ 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);
- pt->write_buf = pt->read_buf = (unsigned char *) c_str;
+ 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);
+
+ 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;
@@ -352,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
@@ -369,20 +374,30 @@ 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, result;
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);
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
+ <http://wingolog.org/archives/2011/02/25/ports-weaks-gc-and-dark-matter>
+ for details. */
+ scm_close_port (port);
+
+ return result;
}
#undef FUNC_NAME
@@ -395,8 +410,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 +455,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,15 +480,12 @@ 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,
"scm_c_read_string");
SCM form;
- /* Read expressions from that port; ignore the values. */
form = scm_read (port);
scm_close_port (port);
@@ -497,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"
@@ -527,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
diff --git a/libguile/symbols.c b/libguile/symbols.c
index b9d41b0..2a1b46d 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");
}
/*
diff --git a/libguile/threads.c b/libguile/threads.c
index e7347ad..14bda1d 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -79,6 +79,122 @@ 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 {
+ 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 *stack_base)
+{
+ return GC_UNIMPLEMENTED;
+}
+
+static void
+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)
+{
+ 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)
+{
+ 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. */
#if (defined(HAVE_GC_DO_BLOCKING) && defined (HAVE_DECL_GC_DO_BLOCKING) &&
defined (HAVE_GC_CALL_WITH_GC_ACTIVE))
@@ -343,6 +459,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 +474,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;
@@ -374,67 +486,75 @@ 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)
-{
- scm_i_thread *t = scm_gc_malloc (sizeof (scm_i_thread), "thread");
-
- 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;
+guilify_self_1 (struct GC_stack_base *base)
+{
+ scm_i_thread t;
+
+ /* 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__
- /* 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;
- 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)
+ 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)
/* 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;
- SET_CURRENT_THREAD (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_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_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_ptr;
+#endif
+
+ 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.
@@ -537,6 +657,15 @@ do_thread_exit (void *v)
return NULL;
}
+static void *
+do_thread_exit_trampoline (struct GC_stack_base *sb, void *v)
+{
+ /* Won't hurt if we are already registered. */
+ GC_register_my_thread (sb);
+
+ return scm_with_guile (do_thread_exit, v);
+}
+
static void
on_thread_exit (void *v)
{
@@ -551,19 +680,18 @@ 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);
+ /* 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
@@ -590,21 +718,21 @@ 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
+#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;
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.
@@ -623,11 +751,9 @@ 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)
{
-#ifndef SCM_HAVE_THREAD_STORAGE_CLASS
scm_i_pthread_once (&init_thread_key_once, init_thread_key);
-#endif
if (SCM_I_CURRENT_THREAD)
{
@@ -647,6 +773,12 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM
parent)
initialization.
*/
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);
}
else
@@ -655,6 +787,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);
}
@@ -662,137 +798,58 @@ 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 ()
+void
+scm_init_guile ()
{
- 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;
+ 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
-#endif
{
-#if SCM_STACK_GROWS_UP
- return start;
-#else
- return end;
-#endif
+ fprintf (stderr, "Failed to get stack base for current thread.\n");
+ exit (1);
}
}
-#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);
-}
-
SCM_UNUSED static void
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);
- scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL);
- res = scm_c_with_continuation_barrier (func, data);
- scm_i_pthread_cleanup_pop (0);
+ res = scm_c_with_continuation_barrier (args->func, args->data);
/* Leave Guile mode. */
t->guile_mode = 0;
@@ -800,14 +857,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.
@@ -816,20 +869,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)
{
@@ -880,9 +952,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;
}
@@ -1965,7 +2034,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);
@@ -1978,7 +2047,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 b5e3c21..9e44684 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);
@@ -192,6 +186,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 +197,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))
diff --git a/libguile/throw.c b/libguile/throw.c
index 750e6a2..9c29351 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));
}
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 20d9ed2..4b0ca3e 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-loader.c b/libguile/vm-i-loader.c
index fae39fb..0d86784 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/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 19b48c5..9e249bc 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)
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 57712ca..71c5281 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 ();
@@ -1156,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);
diff --git a/m4/asm-underscore.m4 b/m4/asm-underscore.m4
deleted file mode 100644
index 15c89cc..0000000
--- 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 <<EOF
-#ifdef __cplusplus
-extern "C" int foo (void);
-#endif
-int foo(void) { return 0; }
-EOF
- # Look for the assembly language name in the .s file.
- AC_TRY_COMMAND(${CC-cc} $CFLAGS $CPPFLAGS -S 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 ed9c4ce..0000000
--- 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 0000000..2e0fb3b
--- /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 <math.h>
+ 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 <math.h>
+ 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 <float.h>
+#include <math.h>
+#include <string.h>
+/* 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 63d3293..2d84c7f 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 a64693b..8a70734 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 0000000..dd400d4
--- /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 <math.h>
+ 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 <math.h>
+ 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 b024dd4..e7c9ba9 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 a4d95aa..aed816c 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(
- address@hidden:@include <limits.h>
- @%:@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(
+ address@hidden:@include <limits.h>
+ @%:@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 a95d905..0000000
--- 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 <math.h> to declare round().
- AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
- AC_CHECK_DECLS([round], , , [#include <math.h>])
- 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 <float.h>
-#include <math.h>
-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 <math.h>
-]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 4883fe2..27f82d5 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 26654c6..e7d0d07 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 <wchar.h>, 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 <inttypes.h>.
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 <wchar.h> (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 b6163d6..7f3ae56 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 <stdio.h> 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 <stdio.h>]],
-[[#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 <cygwin/version.h>
-# 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 d28b552..25fdada 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 606d42e..90c22cf 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.
diff --git a/meta/Makefile.am b/meta/Makefile.am
index fe4aeb4..6bc623e 100644
--- a/meta/Makefile.am
+++ b/meta/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with Automake to create Makefile.in
## Jim Blandy <address@hidden> --- September 1997
##
-## Copyright (C) 1998, 1999, 2001, 2006, 2007, 2008, 2009 Free Software
Foundation, Inc.
+## Copyright (C) 1998, 1999, 2001, 2006, 2007, 2008, 2009, 2011 Free
Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -23,11 +23,11 @@
bin_SCRIPTS = guile-config guile-tools
EXTRA_DIST= \
guile.m4 ChangeLog-2008 \
- guile-2.0.pc.in guile-2.0-uninstalled.pc.in \
+ guile-2.2.pc.in guile-2.2-uninstalled.pc.in \
guile-tools.in guile-config.in
pkgconfigdir = $(libdir)/pkgconfig
-pkgconfig_DATA = guile-2.0.pc
+pkgconfig_DATA = guile-2.2.pc
## FIXME: in the future there will be direct automake support for
## doing this. When that happens, switch over.
diff --git a/meta/guile-2.0-uninstalled.pc.in b/meta/guile-2.2-uninstalled.pc.in
similarity index 100%
rename from meta/guile-2.0-uninstalled.pc.in
rename to meta/guile-2.2-uninstalled.pc.in
diff --git a/meta/guile-2.0.pc.in b/meta/guile-2.2.pc.in
similarity index 100%
rename from meta/guile-2.0.pc.in
rename to meta/guile-2.2.pc.in
diff --git a/meta/guile-config.in b/meta/guile-config.in
index 0226f68..b3e4c3d 100755
--- a/meta/guile-config.in
+++ b/meta/guile-config.in
@@ -8,7 +8,7 @@ exec "@installed_guile@" -e main -s $0 "$@"
;;;; guile-config --- utility for linking programs with Guile
;;;; Jim Blandy <address@hidden> --- September 1997
;;;;
-;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008, 2009 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1998, 2001, 2004, 2005, 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
@@ -77,7 +77,7 @@ exec "@installed_guile@" -e main -s $0 "$@"
(dle " " p " --help - show usage info (this message)")
(dle " " p " --help SUBCOMMAND - show help for SUBCOMMAND")))
-(define guile-module "guile-2.0")
+(define guile-module "guile-2.2")
(define (pkg-config . args)
(let* ((real-args (cons %pkg-config-program args))
diff --git a/meta/guile.m4 b/meta/guile.m4
index aaa9f88..a7186fb 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
diff --git a/meta/uninstalled-env.in b/meta/uninstalled-env.in
index b3deed5..4faad64 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
diff --git a/module/Makefile.am b/module/Makefile.am
index 9940900..2685a3a 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
@@ -180,12 +179,14 @@ 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 \
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 \
@@ -268,7 +269,6 @@ SRFI_SOURCES = \
srfi/srfi-98.scm
RNRS_SOURCES = \
- rnrs.scm \
rnrs/base.scm \
rnrs/conditions.scm \
rnrs/control.scm \
@@ -293,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
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
new file mode 100644
index 0000000..c07900b
--- /dev/null
+++ b/module/ice-9/binary-ports.scm
@@ -0,0 +1,50 @@
+;;;; 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 <address@hidden>
+
+;;; 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
+ get-string-n!
+ 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/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 4b28ad7..327e3fa 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))
@@ -1987,29 +1987,27 @@ 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))))
;; 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 (equal? (module-name used)
- (module-name 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)))
@@ -3406,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
@@ -3498,6 +3497,42 @@ module '(ice-9 q) '(make-q q-length))}."
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?
(let ((using-readline? (make-fluid)))
diff --git a/module/ice-9/eval-string.scm b/module/ice-9/eval-string.scm
new file mode 100644
index 0000000..27448d7
--- /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/module/ice-9/popen.scm b/module/ice-9/popen.scm
index c5b02f7..5445ecb 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)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 207e72c..16c6a90 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -2,14570 +2,14399 @@
(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}#
- (if #f #f))
- (#{set-syntax-object-wrap!\ 355}# (if #f #f))
- (#{set-syntax-object-module!\ 357}# (if #f #f))
- (#{ribcage?\ 399}# (if #f #f)))
- (letrec*
- ((#{make-void\ 239}#
- (lambda (#{src\ 751}#)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- #{src\ 751}#)))
- (#{make-const\ 241}#
- (lambda (#{src\ 753}# #{exp\ 754}#)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #{src\ 753}#
- #{exp\ 754}#)))
- (#{make-lexical-ref\ 245}#
- (lambda (#{src\ 761}# #{name\ 762}# #{gensym\ 763}#)
- (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}#)
- (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}#)
- (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}#)
- (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}#)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #{src\ 793}#
- #{name\ 794}#)))
- (#{make-toplevel-set\ 255}#
- (lambda (#{src\ 797}# #{name\ 798}# #{exp\ 799}#)
- (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}#)
- (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}#)
- (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}#)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #{src\ 817}#
- #{proc\ 818}#
- #{args\ 819}#)))
- (#{make-sequence\ 263}#
- (lambda (#{src\ 823}# #{exps\ 824}#)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 12)
- #{src\ 823}#
- #{exps\ 824}#)))
- (#{make-lambda\ 265}#
- (lambda (#{src\ 827}# #{meta\ 828}# #{body\ 829}#)
- (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}#)
- (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}#)
- (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}#)
- (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}#)
- (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}#)
- (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}#)
- (module-define!
- (current-module)
- #{symbol\ 899}#
- (make-syntax-transformer
- #{symbol\ 899}#
- #{type\ 900}#
- #{val\ 901}#))))
- (#{get-global-definition-hook\ 297}#
- (lambda (#{symbol\ 905}# #{module\ 906}#)
+ (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\ 906}#) (current-module) #f)
- (warn "module system is booted, we should have a module"
- #{symbol\ 905}#))
- (begin
- (let ((#{v\ 912}# (module-variable
- (if #{module\ 906}#
- (resolve-module (cdr #{module\ 906}#))
- (current-module))
- #{symbol\ 905}#)))
- (if #{v\ 912}#
- (if (variable-bound? #{v\ 912}#)
- (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}#))
- #f)
- #f)))
- #f)
- #f))))))
- (#{decorate-source\ 299}#
- (lambda (#{e\ 921}# #{s\ 922}#)
+ (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
- (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}#)
- (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 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
- (#{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}#)
- (begin
- (let ((#{kind\ 983}# (car #{mod\ 973}#))
- (#{mod\ 984}# (cdr #{mod\ 973}#)))
- (if (eqv? #{kind\ 983}# 'public)
- (#{modref-cont\ 975}#
- #{mod\ 984}#
- #{var\ 974}#
- #t)
- (if (eqv? #{kind\ 983}# 'private)
- (if (not (equal?
- #{mod\ 984}#
- (module-name (current-module))))
- (#{modref-cont\ 975}#
- #{mod\ 984}#
- #{var\ 974}#
- #f)
- (#{bare-cont\ 976}# #{var\ 974}#))
- (if (eqv? #{kind\ 983}# 'bare)
- (#{bare-cont\ 976}# #{var\ 974}#)
- (if (eqv? #{kind\ 983}# 'hygiene)
- (if (if (not (equal?
- #{mod\ 984}#
- (module-name (current-module))))
- (module-variable
- (resolve-module #{mod\ 984}#)
- #{var\ 974}#)
- #f)
- (#{modref-cont\ 975}#
- #{mod\ 984}#
- #{var\ 974}#
+ (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)
- (#{bare-cont\ 976}# #{var\ 974}#))
- (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}#)
- (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}#)
- (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}#
- #f
- #{rest\ 1030}#
- #f
- '()
- #{vars\ 1031}#
- #{exp\ 1033}#
- #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}#)
- (if (equal? (module-name (current-module)) '(guile))
- (#{make-toplevel-ref\ 253}#
- #{src\ 1064}#
- #{name\ 1065}#)
- (#{make-module-ref\ 249}#
- #{src\ 1064}#
- '(guile)
- #{name\ 1065}#
- #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}#)
+ (#{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}#
+ #{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!\ 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}#)
- (begin
- (let ((#{f\ 1100}# (car #{vars\ 1088}#))
- (#{f-name\ 1101}# (car #{ids\ 1087}#))
- (#{vars\ 1102}# (cdr #{vars\ 1088}#))
- (#{ids\ 1103}# (cdr #{ids\ 1087}#)))
- (begin
- (let ((#{proc\ 1105}#
- (#{build-simple-lambda\ 323}#
- #{src\ 1086}#
- #{ids\ 1103}#
- #f
- #{vars\ 1102}#
- '()
- #{body-exp\ 1090}#)))
- (begin
- (#{maybe-name-value!\ 301}#
- #{f-name\ 1101}#
- #{proc\ 1105}#)
- (for-each
- #{maybe-name-value!\ 301}#
- #{ids\ 1103}#
- #{val-exps\ 1089}#)
- (#{make-letrec\ 271}#
- #{src\ 1086}#
- #f
- (list #{f-name\ 1101}#)
- (list #{f\ 1100}#)
- (list #{proc\ 1105}#)
- (#{build-application\ 305}#
- #{src\ 1086}#
- (#{build-lexical-reference\ 311}#
- '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}#
- (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}#)
- (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)
- #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}#)
- (begin
- (let ((#{props\ 1154}# (source-properties #{x\ 1147}#)))
- (if (pair? #{props\ 1154}#) #{props\ 1154}# #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}#)
- '()
+ #{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
- (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 ((#{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\ 1181}# (assq #{x\ 1173}# #{r\ 1174}#)))
- (if #{t\ 1181}#
- (cdr #{t\ 1181}#)
- (if (symbol? #{x\ 1173}#)
- (begin
- (let ((#{t\ 1187}#
- (#{get-global-definition-hook\ 297}#
- #{x\ 1173}#
- #{mod\ 1175}#)))
- (if #{t\ 1187}# #{t\ 1187}# '(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}#)
+ (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\ 347}# #{x\ 1198}#))
- #f)))
- (#{id?\ 379}#
- (lambda (#{x\ 1202}#)
- (if (symbol? #{x\ 1202}#)
- #t
- (if (#{syntax-object?\ 345}# #{x\ 1202}#)
- (symbol?
- (#{syntax-object-expression\ 347}# #{x\ 1202}#))
- #f))))
- (#{id-sym-name&marks\ 382}#
- (lambda (#{x\ 1209}# #{w\ 1210}#)
- (if (#{syntax-object?\ 345}# #{x\ 1209}#)
- (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}#
- (lambda () (symbol->string (gensym "i"))))
- (#{gen-labels\ 394}#
- (lambda (#{ls\ 1216}#)
- (if (null? #{ls\ 1216}#)
- '()
- (cons (#{gen-label\ 392}#)
- (#{gen-labels\ 394}# (cdr #{ls\ 1216}#))))))
- (#{make-ribcage\ 397}#
- (lambda (#{symnames\ 1218}#
- #{marks\ 1219}#
- #{labels\ 1220}#)
- (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}#)
- (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}#)
- (cons (begin
- (let ((#{labelvec\ 1269}#
- (list->vector #{labels\ 1261}#)))
- (begin
- (let ((#{n\ 1271}#
- (vector-length #{labelvec\ 1269}#)))
- (begin
- (let ((#{symnamevec\ 1274}#
- (make-vector #{n\ 1271}#))
- (#{marksvec\ 1275}#
- (make-vector #{n\ 1271}#)))
- (begin
- (letrec*
- ((#{f\ 1279}#
- (lambda (#{ids\ 1280}#
- #{i\ 1281}#)
- (if (not (null? #{ids\ 1280}#))
- (call-with-values
- (lambda ()
- (#{id-sym-name&marks\
382}#
- (car #{ids\ 1280}#)
- #{w\ 1262}#))
- (lambda (#{symname\ 1282}#
- #{marks\ 1283}#)
- (begin
- (vector-set!
- #{symnamevec\ 1274}#
- #{i\ 1281}#
- #{symname\ 1282}#)
- (vector-set!
- #{marksvec\ 1275}#
- #{i\ 1281}#
- #{marks\ 1283}#)
- (#{f\ 1279}#
- (cdr #{ids\ 1280}#)
- (#{fx+\ 282}#
- #{i\ 1281}#
- 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}#)
- (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}#)
- (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}#))
- #f)
+ (#{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 ((#{n 1318}#
+ (vector-length #{labelvec 1316}#)))
+ (begin
+ (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}#))
+ (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))))))
- (#{id-var-name\ 433}#
- (lambda (#{id\ 1323}# #{w\ 1324}#)
- (letrec*
- ((#{search\ 1329}#
- (lambda (#{sym\ 1345}# #{subst\ 1346}# #{marks\ 1347}#)
- (if (null? #{subst\ 1346}#)
- (values #f #{marks\ 1347}#)
- (begin
- (let ((#{fst\ 1352}# (car #{subst\ 1346}#)))
- (if (eq? #{fst\ 1352}# 'shift)
- (#{search\ 1329}#
- #{sym\ 1345}#
- (cdr #{subst\ 1346}#)
- (cdr #{marks\ 1347}#))
- (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}#)
- (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}#
- (list-ref
- (#{ribcage-marks\ 403}#
- #{ribcage\ 1359}#)
- #{i\ 1370}#))
- #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}#)
+ #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 ((#{n\ 1389}# (vector-length #{symnames\ 1381}#)))
- (letrec*
- ((#{f\ 1392}#
- (lambda (#{i\ 1393}#)
- (if (#{fx=\ 286}# #{i\ 1393}# #{n\ 1389}#)
- (#{search\ 1329}#
- #{sym\ 1378}#
- (cdr #{subst\ 1379}#)
- #{marks\ 1380}#)
- (if (if (eq? (vector-ref
- #{symnames\ 1381}#
- #{i\ 1393}#)
- #{sym\ 1378}#)
- (#{same-marks?\ 431}#
- #{marks\ 1380}#
- (vector-ref
- (#{ribcage-marks\ 403}#
- #{ribcage\ 1382}#)
- #{i\ 1393}#))
- #f)
- (values
- (vector-ref
- (#{ribcage-labels\ 405}#
- #{ribcage\ 1382}#)
- #{i\ 1393}#)
- #{marks\ 1380}#)
- (#{f\ 1392}#
- (#{fx+\ 282}# #{i\ 1393}# 1)))))))
- (begin (#{f\ 1392}# 0))))))))
- (begin
- (if (symbol? #{id\ 1323}#)
+ (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 ((#{t\ 1403}#
- (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}#)
- (begin
- (let ((#{id\ 1416}#
- (#{syntax-object-expression\ 347}#
- #{id\ 1323}#))
- (#{w1\ 1417}#
- (#{syntax-object-wrap\ 349}# #{id\ 1323}#)))
- (begin
- (let ((#{marks\ 1419}#
- (#{join-marks\ 429}#
- (car #{w\ 1324}#)
- (car #{w1\ 1417}#))))
- (call-with-values
- (lambda ()
- (#{search\ 1329}#
- #{id\ 1416}#
- (cdr #{w\ 1324}#)
- #{marks\ 1419}#))
- (lambda (#{new-id\ 1423}# #{marks\ 1424}#)
- (begin
- (let ((#{t\ 1429}# #{new-id\ 1423}#))
- (if #{t\ 1429}#
- #{t\ 1429}#
- (begin
- (let ((#{t\ 1432}#
- (call-with-values
- (lambda ()
- (#{search\ 1329}#
- #{id\ 1416}#
- (cdr #{w1\ 1417}#)
- #{marks\ 1424}#))
- (lambda (#{x\ 1435}#
- .
- #{ignore\ 1436}#)
- #{x\ 1435}#))))
- (if #{t\ 1432}#
- #{t\ 1432}#
- #{id\ 1416}#))))))))))))
- (syntax-violation
- 'id-var-name
- "invalid id"
- #{id\ 1323}#)))))))
- (#{free-id=?\ 435}#
- (lambda (#{i\ 1441}# #{j\ 1442}#)
- (if (eq? (begin
- (let ((#{x\ 1448}# #{i\ 1441}#))
- (if (#{syntax-object?\ 345}# #{x\ 1448}#)
- (#{syntax-object-expression\ 347}# #{x\ 1448}#)
- #{x\ 1448}#)))
+ (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}#))))
+ (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 ((#{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}# '(())))
- #f)))
- (#{bound-id=?\ 437}#
- (lambda (#{i\ 1455}# #{j\ 1456}#)
- (if (if (#{syntax-object?\ 345}# #{i\ 1455}#)
- (#{syntax-object?\ 345}# #{j\ 1456}#)
- #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}#)))
+ (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)
- (eq? #{i\ 1455}# #{j\ 1456}#))))
- (#{valid-bound-ids?\ 439}#
- (lambda (#{ids\ 1465}#)
- (if (letrec*
- ((#{all-ids?\ 1470}#
- (lambda (#{ids\ 1471}#)
- (begin
- (let ((#{t\ 1474}# (null? #{ids\ 1471}#)))
- (if #{t\ 1474}#
- #{t\ 1474}#
- (if (#{id?\ 379}# (car #{ids\ 1471}#))
- (#{all-ids?\ 1470}# (cdr #{ids\ 1471}#))
- #f)))))))
- (begin (#{all-ids?\ 1470}# #{ids\ 1465}#)))
- (#{distinct-bound-ids?\ 441}# #{ids\ 1465}#)
- #f)))
- (#{distinct-bound-ids?\ 441}#
- (lambda (#{ids\ 1479}#)
+ #{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*
- ((#{distinct?\ 1483}#
- (lambda (#{ids\ 1484}#)
- (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}#))
- #f)))))))
- (begin (#{distinct?\ 1483}# #{ids\ 1479}#)))))
- (#{bound-id-member?\ 443}#
- (lambda (#{x\ 1491}# #{list\ 1492}#)
- (if (not (null? #{list\ 1492}#))
+ ((#{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
- (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}#)))))
- #f)))
- (#{wrap\ 445}#
- (lambda (#{x\ 1501}# #{w\ 1502}# #{defmod\ 1503}#)
- (if (if (null? (car #{w\ 1502}#))
- (null? (cdr #{w\ 1502}#))
- #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}#
- (letrec*
- ((#{dobody\ 1541}#
- (lambda (#{body\ 1542}#
- #{r\ 1543}#
- #{w\ 1544}#
- #{mod\ 1545}#)
- (if (null? #{body\ 1542}#)
- '()
- (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}#))))))))
- (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 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 ((#{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 ((#{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 ((#{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
+ "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
+ (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
- #{name\ 1578}#
- (#{build-application\ 305}#
+ (#{build-primref 326}#
#f
- (#{build-primref\ 329}#
- #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}#)
- (letrec*
- ((#{f\ 1596}#
- (lambda (#{when-list\ 1597}# #{situations\ 1598}#)
- (if (null? #{when-list\ 1597}#)
- #{situations\ 1598}#
- (#{f\ 1596}#
- (cdr #{when-list\ 1597}#)
- (cons (begin
- (let ((#{x\ 1600}# (car #{when-list\ 1597}#)))
- (if (#{free-id=?\ 435}#
- #{x\ 1600}#
- '#(syntax-object
- compile
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("i1599"))
- #(ribcage () () ())
- #(ribcage
- #(f when-list situations)
- #((top) (top) (top))
- #("i1593" "i1594" "i1595"))
- #(ribcage () () ())
- #(ribcage
- #(e when-list w)
- #((top) (top) (top))
- #("i1590" "i1591" "i1592"))
- #(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
- chi-top
- syntax-type
- chi-when-list
- chi-install-global
- chi-top-sequence
- chi-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- 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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors
- and-map*)
- ((top) (top) (top) (top))
- ("i40" "i39" "i38" "i36")))
- (hygiene guile)))
- 'compile
- (if (#{free-id=?\ 435}#
- #{x\ 1600}#
- '#(syntax-object
- load
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("i1599"))
- #(ribcage () () ())
- #(ribcage
- #(f when-list situations)
- #((top) (top) (top))
- #("i1593" "i1594" "i1595"))
- #(ribcage () () ())
- #(ribcage
- #(e when-list w)
- #((top) (top) (top))
- #("i1590" "i1591" "i1592"))
- #(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
- chi-top
- syntax-type
- chi-when-list
- chi-install-global
- chi-top-sequence
- chi-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- 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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors
- and-map*)
- ((top) (top) (top) (top))
- ("i40" "i39" "i38" "i36")))
- (hygiene guile)))
- 'load
- (if (#{free-id=?\ 435}#
- #{x\ 1600}#
- '#(syntax-object
- eval
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("i1599"))
- #(ribcage () () ())
- #(ribcage
- #(f when-list situations)
- #((top) (top) (top))
- #("i1593" "i1594" "i1595"))
- #(ribcage () () ())
- #(ribcage
- #(e when-list w)
- #((top) (top) (top))
- #("i1590" "i1591" "i1592"))
- #(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
- chi-top
- syntax-type
- chi-when-list
- chi-install-global
- chi-top-sequence
- chi-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- 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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
- (define-structure
- define-expansion-accessors
-
define-expansion-constructors
- and-map*)
- ((top) (top) (top) (top))
- ("i40" "i39" "i38" "i36")))
- (hygiene guile)))
- 'eval
- (if (#{free-id=?\ 435}#
- #{x\ 1600}#
- '#(syntax-object
- expand
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("i1599"))
- #(ribcage () () ())
- #(ribcage
- #(f when-list situations)
- #((top) (top) (top))
- #("i1593" "i1594" "i1595"))
- #(ribcage () () ())
- #(ribcage
- #(e when-list w)
- #((top) (top) (top))
- #("i1590" "i1591" "i1592"))
- #(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
- chi-top
- syntax-type
- chi-when-list
- chi-install-global
- chi-top-sequence
- chi-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- 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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors
- and-map*)
- ((top) (top) (top) (top))
- ("i40" "i39" "i38" "i36")))
- (hygiene guile)))
- 'expand
- (syntax-violation
- 'eval-when
- "invalid situation"
- #{e\ 1587}#
- (#{wrap\ 445}#
- #{x\ 1600}#
- #{w\ 1589}#
- #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}#)
- (begin
- (let ((#{n\ 1628}#
- (#{id-var-name\ 433}# #{e\ 1610}# #{w\ 1612}#)))
- (begin
- (let ((#{b\ 1630}#
- (#{lookup\ 373}#
- #{n\ 1628}#
- #{r\ 1611}#
- #{mod\ 1615}#)))
- (begin
- (let ((#{type\ 1632}# (car #{b\ 1630}#)))
- (if (eqv? #{type\ 1632}# 'lexical)
- (values
- #{type\ 1632}#
- (cdr #{b\ 1630}#)
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (if (eqv? #{type\ 1632}# 'global)
- (values
- #{type\ 1632}#
- #{n\ 1628}#
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (if (eqv? #{type\ 1632}# 'macro)
- (if #{for-car?\ 1616}#
- (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}#
- '(())
- #{s\ 1613}#
- #{rib\ 1614}#
- #{mod\ 1615}#
- #f))
- (values
- #{type\ 1632}#
- (cdr #{b\ 1630}#)
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#))))))))))
- (if (pair? #{e\ 1610}#)
- (begin
- (let ((#{first\ 1646}# (car #{e\ 1610}#)))
- (call-with-values
- (lambda ()
- (#{syntax-type\ 457}#
- #{first\ 1646}#
- #{r\ 1611}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{rib\ 1614}#
- #{mod\ 1615}#
- #t))
- (lambda (#{ftype\ 1647}#
- #{fval\ 1648}#
- #{fe\ 1649}#
- #{fw\ 1650}#
- #{fs\ 1651}#
- #{fmod\ 1652}#)
- (if (eqv? #{ftype\ 1647}# 'lexical)
- (values
- 'lexical-call
- #{fval\ 1648}#
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (if (eqv? #{ftype\ 1647}# '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}#
- '(())
- #{s\ 1613}#
- #{rib\ 1614}#
- #{mod\ 1615}#
- #{for-car?\ 1616}#)
- (if (eqv? #{ftype\ 1647}# '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)
- (values
- 'core-form
- #{fval\ 1648}#
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (if (eqv? #{ftype\ 1647}# 'local-syntax)
- (values
- 'local-syntax-form
- #{fval\ 1648}#
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (if (eqv? #{ftype\ 1647}# 'begin)
- (values
- 'begin-form
- #f
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (if (eqv? #{ftype\ 1647}# '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}#
- ($sc-dispatch
- #{tmp\ 1679}#
- '(_ any any))))
- (if (if #{tmp\ 1680}#
- (@apply
- (lambda (#{name\ 1683}#
- #{val\ 1684}#)
- (#{id?\ 379}#
- #{name\ 1683}#))
- #{tmp\ 1680}#)
- #f)
- (@apply
- (lambda (#{name\ 1687}#
- #{val\ 1688}#)
- (values
- 'define-form
- #{name\ 1687}#
- #{val\ 1688}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#))
- #{tmp\ 1680}#)
- (let ((#{tmp\ 1689}#
- ($sc-dispatch
- #{tmp\ 1679}#
- '(_ (any . any)
- any
- .
- each-any))))
- (if (if #{tmp\ 1689}#
- (@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}#))
- #f))
- #{tmp\ 1689}#)
- #f)
- (@apply
- (lambda (#{name\ 1704}#
- #{args\ 1705}#
- #{e1\ 1706}#
- #{e2\ 1707}#)
- (values
- 'define-form
- (#{wrap\ 445}#
- #{name\ 1704}#
- #{w\ 1612}#
- #{mod\ 1615}#)
- (#{decorate-source\
299}#
- (cons
'#(syntax-object
- lambda
- ((top)
-
#(ribcage
- #(name
- args
- e1
- e2)
-
#((top)
-
(top)
-
(top)
-
(top))
-
#("i1700"
-
"i1701"
-
"i1702"
-
"i1703"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
-
#(ftype
- fval
- fe
- fw
- fs
-
fmod)
-
#((top)
-
(top)
-
(top)
-
(top)
-
(top)
-
(top))
-
#("i1653"
-
"i1654"
-
"i1655"
-
"i1656"
-
"i1657"
-
"i1658"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
-
#(first)
-
#((top))
-
#("i1645"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
- #(e
- r
- w
- s
- rib
- mod
-
for-car?)
-
#((top)
-
(top)
-
(top)
-
(top)
-
(top)
-
(top)
-
(top))
-
#("i1617"
-
"i1618"
-
"i1619"
-
"i1620"
-
"i1621"
-
"i1622"
-
"i1623"))
-
#(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
-
chi-top
-
syntax-type
-
chi-when-list
-
chi-install-global
-
chi-top-sequence
-
chi-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
-
lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
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)
-
(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"
-
"i420"
-
"i419"
-
"i418"
-
"i416"
-
"i415"
-
"i414"
-
"i413"
-
"i412"
-
"i410"
-
"i408"
-
"i406"
-
"i404"
-
"i402"
-
"i400"
-
"i398"
-
"i396"
-
"i393"
-
"i391"
-
"i390"
-
"i389"
-
"i388"
-
"i387"
-
"i386"
-
"i385"
-
"i384"
-
"i383"
-
"i381"
-
"i380"
-
"i378"
-
"i376"
-
"i374"
-
"i372"
-
"i370"
-
"i368"
-
"i366"
-
"i365"
-
"i364"
-
"i363"
-
"i362"
-
"i361"
-
"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"
-
"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"))
-
#(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors
-
and-map*)
- ((top)
- (top)
- (top)
-
(top))
- ("i40"
- "i39"
- "i38"
-
"i36")))
- (hygiene
- guile))
- (#{wrap\
445}#
- (cons
#{args\ 1705}#
-
(cons #{e1\ 1706}#
-
#{e2\ 1707}#))
- #{w\
1612}#
- #{mod\
1615}#))
- #{s\ 1613}#)
- '(())
- #{s\ 1613}#
- #{mod\ 1615}#))
- #{tmp\ 1689}#)
- (let ((#{tmp\ 1710}#
- ($sc-dispatch
- #{tmp\ 1679}#
- '(_ any))))
- (if (if #{tmp\ 1710}#
- (@apply
- (lambda
(#{name\ 1712}#)
- (#{id?\ 379}#
- #{name\
1712}#))
- #{tmp\ 1710}#)
- #f)
- (@apply
- (lambda (#{name\
1714}#)
- (values
- 'define-form
- (#{wrap\ 445}#
- #{name\ 1714}#
- #{w\ 1612}#
- #{mod\ 1615}#)
-
'(#(syntax-object
- if
- ((top)
- #(ribcage
- #(name)
- #((top))
-
#("i1713"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(ftype
- fval
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i1653"
- "i1654"
- "i1655"
- "i1656"
- "i1657"
-
"i1658"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(first)
- #((top))
-
#("i1645"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
-
for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i1617"
- "i1618"
- "i1619"
- "i1620"
- "i1621"
- "i1622"
-
"i1623"))
- #(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
- chi-top
-
syntax-type
-
chi-when-list
-
chi-install-global
-
chi-top-sequence
-
chi-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors
-
and-map*)
- ((top)
- (top)
- (top)
- (top))
- ("i40"
- "i39"
- "i38"
- "i36")))
- (hygiene
- guile))
-
#(syntax-object
- #f
- ((top)
- #(ribcage
- #(name)
- #((top))
-
#("i1713"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(ftype
- fval
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i1653"
- "i1654"
- "i1655"
- "i1656"
- "i1657"
-
"i1658"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(first)
- #((top))
-
#("i1645"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
-
for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i1617"
- "i1618"
- "i1619"
- "i1620"
- "i1621"
- "i1622"
-
"i1623"))
- #(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
- chi-top
-
syntax-type
-
chi-when-list
-
chi-install-global
-
chi-top-sequence
-
chi-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors
-
and-map*)
- ((top)
- (top)
- (top)
- (top))
- ("i40"
- "i39"
- "i38"
- "i36")))
- (hygiene
- guile))
-
#(syntax-object
- #f
- ((top)
- #(ribcage
- #(name)
- #((top))
-
#("i1713"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(ftype
- fval
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i1653"
- "i1654"
- "i1655"
- "i1656"
- "i1657"
-
"i1658"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(first)
- #((top))
-
#("i1645"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
-
for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i1617"
- "i1618"
- "i1619"
- "i1620"
- "i1621"
- "i1622"
-
"i1623"))
- #(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
- chi-top
-
syntax-type
-
chi-when-list
-
chi-install-global
-
chi-top-sequence
-
chi-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors
-
and-map*)
- ((top)
- (top)
- (top)
- (top))
- ("i40"
- "i39"
- "i38"
- "i36")))
- (hygiene
- guile)))
- '(())
- #{s\ 1613}#
- #{mod\ 1615}#))
- #{tmp\ 1710}#)
- (syntax-violation
- #f
- "source expression
failed to match any pattern"
- #{tmp\
1679}#))))))))
- (if (eqv? #{ftype\ 1647}#
- 'define-syntax)
- (let ((#{tmp\ 1717}# #{e\ 1610}#))
- (let ((#{tmp\ 1718}#
- ($sc-dispatch
- #{tmp\ 1717}#
- '(_ any any))))
- (if (if #{tmp\ 1718}#
- (@apply
- (lambda (#{name\
1721}#
- #{val\
1722}#)
- (#{id?\ 379}#
- #{name\ 1721}#))
- #{tmp\ 1718}#)
- #f)
- (@apply
- (lambda (#{name\ 1725}#
- #{val\ 1726}#)
- (values
- 'define-syntax-form
- #{name\ 1725}#
- #{val\ 1726}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#))
- #{tmp\ 1718}#)
- (syntax-violation
- #f
- "source expression failed
to match any pattern"
- #{tmp\ 1717}#))))
- (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}#))
- (begin
- (let ((#{t\ 1732}#
- (#{source-annotation\ 360}# #{e\ 1610}#)))
- (if #{t\ 1732}# #{t\ 1732}# #{s\ 1613}#)))
- #{rib\ 1614}#
- (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}#)
- (values
- 'constant
- #f
- #{e\ 1610}#
- #{w\ 1612}#
- #{s\ 1613}#
- #{mod\ 1615}#)
- (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}#)
- (call-with-values
- (lambda ()
- (#{syntax-type\ 457}#
- #{e\ 1741}#
- #{r\ 1742}#
- #{w\ 1743}#
- (#{source-annotation\ 360}# #{e\ 1741}#)
- #f
- #{mod\ 1746}#
- #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}#
- 'value
- #{s\ 1900}#
- #{e\ 1897}#
- #{value\ 1896}#)
- (if (if (eqv? #{type\ 1895}# '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)
- (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}#
- (begin
- (let ((#{id\ 1924}# (car #{e\ 1897}#)))
- (#{build-lexical-reference\ 311}#
- '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}#)
- '(())))
- (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}#
- ($sc-dispatch
- #{tmp\ 1931}#
- '(_ any . each-any))))
- (if #{tmp\ 1932}#
- (@apply
- (lambda (#{e1\ 1935}# #{e2\ 1936}#)
- (#{chi-sequence\ 449}#
- (cons #{e1\ 1935}# #{e2\ 1936}#)
- #{r\ 1898}#
- #{w\ 1899}#
- #{s\ 1900}#
- #{mod\ 1901}#))
- #{tmp\ 1932}#)
- (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}#
- ($sc-dispatch
- #{tmp\ 1940}#
- '(_ each-any any . each-any))))
- (if #{tmp\ 1941}#
- (@apply
- (lambda (#{x\ 1945}#
- #{e1\ 1946}#
- #{e2\ 1947}#)
- (begin
- (let ((#{when-list\ 1949}#
- (#{chi-when-list\ 455}#
- #{e\ 1897}#
- #{x\ 1945}#
- #{w\ 1899}#)))
- (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}#)
- (syntax-violation
- #f
- "source expression failed to match
any pattern"
- #{tmp\ 1940}#))))
- (if (if (eqv? #{type\ 1895}# 'define-form)
- #t
- (eqv? #{type\ 1895}#
- '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)
- (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}#
- 'displaced-lexical)
- (syntax-violation
- #f
- "reference to identifier outside
its scope"
- (#{source-wrap\ 447}#
- #{e\ 1897}#
- #{w\ 1899}#
- #{s\ 1900}#
- #{mod\ 1901}#))
- (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}#
- (@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}#)
- (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}#)
- (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}#)
- (begin
- (let ((#{w\ 2002}#
- (#{syntax-object-wrap\ 349}# #{x\ 1993}#)))
- (begin
- (let ((#{ms\ 2005}# (car #{w\ 2002}#))
- (#{s\ 2006}# (cdr #{w\ 2002}#)))
- (if (if (pair? #{ms\ 2005}#)
- (eq? (car #{ms\ 2005}#) #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}#)
- (begin
- (let ((#{n\ 2018}# (vector-length #{x\ 1993}#)))
- (begin
- (let ((#{v\ 2020}#
- (#{decorate-source\ 299}#
- (make-vector #{n\ 2018}#)
- #{x\ 1993}#)))
- (letrec*
- ((#{loop\ 2023}#
- (lambda (#{i\ 2024}#)
- (if (#{fx=\ 286}#
- #{i\ 2024}#
- #{n\ 2018}#)
- (begin (if #f #f) #{v\ 2020}#)
- (begin
- (vector-set!
- #{v\ 2020}#
- #{i\ 2024}#
- (#{rebuild-macro-output\ 1992}#
- (vector-ref
- #{x\ 1993}#
- #{i\ 2024}#)
- #{m\ 1994}#))
- (#{loop\ 2023}#
- (#{fx+\ 282}#
- #{i\ 2024}#
- 1)))))))
- (begin (#{loop\ 2023}# 0)))))))
- (if (symbol? #{x\ 1993}#)
- (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}#))))))))
- (begin
- (#{rebuild-macro-output\ 1992}#
- (#{p\ 1977}#
- (#{source-wrap\ 447}#
- #{e\ 1978}#
- (#{anti-mark\ 417}# #{w\ 1980}#)
- #{s\ 1981}#
- #{mod\ 1983}#))
- (gensym "m"))))))
- (#{chi-body\ 469}#
- (lambda (#{body\ 2032}#
- #{outer-form\ 2033}#
- #{r\ 2034}#
- #{w\ 2035}#
- #{mod\ 2036}#)
- (begin
- (let ((#{r\ 2044}#
- (cons '("placeholder" placeholder) #{r\ 2034}#)))
- (begin
- (let ((#{ribcage\ 2046}#
- (#{make-ribcage\ 397}# '() '() '())))
- (begin
- (let ((#{w\ 2049}#
- (cons (car #{w\ 2035}#)
- (cons #{ribcage\ 2046}#
- (cdr #{w\ 2035}#)))))
- (letrec*
- ((#{parse\ 2061}#
- (lambda (#{body\ 2062}#
- #{ids\ 2063}#
- #{labels\ 2064}#
- #{var-ids\ 2065}#
- #{vars\ 2066}#
- #{vals\ 2067}#
- #{bindings\ 2068}#)
- (if (null? #{body\ 2062}#)
- (syntax-violation
- #f
- "no expressions in body"
- #{outer-form\ 2033}#)
- (begin
- (let ((#{e\ 2073}#
- (cdr (car #{body\ 2062}#)))
- (#{er\ 2074}#
- (car (car #{body\ 2062}#))))
- (call-with-values
- (lambda ()
- (#{syntax-type\ 457}#
- #{e\ 2073}#
- #{er\ 2074}#
- '(())
- (#{source-annotation\ 360}#
- #{er\ 2074}#)
- #{ribcage\ 2046}#
- #{mod\ 2036}#
- #f))
- (lambda (#{type\ 2076}#
- #{value\ 2077}#
- #{e\ 2078}#
- #{w\ 2079}#
- #{s\ 2080}#
- #{mod\ 2081}#)
- (if (eqv? #{type\ 2076}#
- 'define-form)
- (begin
- (let ((#{id\ 2091}#
- (#{wrap\ 445}#
- #{value\ 2077}#
- #{w\ 2079}#
- #{mod\ 2081}#))
- (#{label\ 2092}#
- (#{gen-label\ 392}#)))
- (begin
- (let ((#{var\ 2094}#
- (#{gen-var\ 489}#
- #{id\ 2091}#)))
- (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}#)
- (cons (cons 'lexical
- #{var\
2094}#)
- #{bindings\
2068}#)))))))
- (if (eqv? #{type\ 2076}#
- 'define-syntax-form)
- (begin
- (let ((#{id\ 2099}#
- (#{wrap\ 445}#
- #{value\ 2077}#
- #{w\ 2079}#
- #{mod\ 2081}#))
- (#{label\ 2100}#
- (#{gen-label\ 392}#)))
- (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}#
- (cons (cons 'macro
- (cons #{er\
2074}#
-
(#{wrap\ 445}#
- #{e\
2078}#
- #{w\
2079}#
-
#{mod\ 2081}#)))
- #{bindings\
2068}#)))))
- (if (eqv? #{type\ 2076}#
- 'begin-form)
- (let ((#{tmp\ 2103}#
- #{e\ 2078}#))
- (let ((#{tmp\ 2104}#
- ($sc-dispatch
- #{tmp\ 2103}#
- '(_ . each-any))))
- (if #{tmp\ 2104}#
- (@apply
- (lambda (#{e1\ 2106}#)
- (#{parse\ 2061}#
- (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}#)))))))
- (begin
- (#{f\ 2109}#
- #{e1\
2106}#)))
- #{ids\ 2063}#
- #{labels\ 2064}#
- #{var-ids\ 2065}#
- #{vars\ 2066}#
- #{vals\ 2067}#
- #{bindings\
2068}#))
- #{tmp\ 2104}#)
- (syntax-violation
- #f
- "source expression
failed to match any pattern"
- #{tmp\ 2103}#))))
- (if (eqv? #{type\ 2076}#
- '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}#
- (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}#)))))))
- (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
- (map (lambda (#{x\
2129}#)
- (#{chi\ 461}#
- (cdr #{x\
2129}#)
- (car #{x\
2129}#)
- '(())
- #{mod\ 2081}#))
- (cons (cons #{er\
2074}#
-
(#{source-wrap\ 447}#
- #{e\
2078}#
- #{w\
2079}#
- #{s\
2080}#
-
#{mod\ 2081}#))
- (cdr #{body\
2062}#))))
- (begin
- (if (not
(#{valid-bound-ids?\ 439}#
- #{ids\
2063}#))
- (syntax-violation
- #f
- "invalid or
duplicate identifier in definition"
- #{outer-form\
2033}#))
- (letrec*
- ((#{loop\ 2136}#
- (lambda (#{bs\
2137}#
-
#{er-cache\ 2138}#
- #{r-cache\
2139}#)
- (if (not (null?
#{bs\ 2137}#))
- (begin
- (let ((#{b\
2142}#
- (car
#{bs\ 2137}#)))
- (if (eq?
(car #{b\ 2142}#)
-
'macro)
- (begin
- (let
((#{er\ 2145}#
-
(car (cdr #{b\ 2142}#))))
- (begin
-
(let ((#{r-cache\ 2147}#
-
(if (eq? #{er\ 2145}#
-
#{er-cache\ 2138}#)
-
#{r-cache\ 2139}#
-
(#{macros-only-env\ 371}#
-
#{er\ 2145}#))))
-
(begin
-
(set-cdr!
-
#{b\ 2142}#
-
(#{eval-local-transformer\ 473}#
-
(#{chi\ 461}#
-
(cdr (cdr #{b\ 2142}#))
-
#{r-cache\ 2147}#
-
'(())
-
#{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}#))))))))
- (begin
- (#{loop\ 2136}#
- #{bindings\ 2068}#
- #f
- #f)))
- (set-cdr!
- #{r\ 2044}#
- (#{extend-env\ 367}#
- #{labels\ 2064}#
- #{bindings\ 2068}#
- (cdr #{r\ 2044}#)))
- (#{build-letrec\ 339}#
- #f
- #t
- (reverse
- (map syntax->datum
- #{var-ids\
2065}#))
- (reverse
- #{vars\ 2066}#)
- (map (lambda (#{x\
2150}#)
- (#{chi\ 461}#
- (cdr #{x\
2150}#)
- (car #{x\
2150}#)
- '(())
- #{mod\
2081}#))
- (reverse
- #{vals\ 2067}#))
- (#{build-sequence\
333}#
- #f
- (map (lambda (#{x\
2154}#)
- (#{chi\ 461}#
- (cdr #{x\
2154}#)
- (car #{x\
2154}#)
- '(())
- #{mod\
2081}#))
- (cons (cons
#{er\ 2074}#
-
(#{source-wrap\ 447}#
-
#{e\ 2078}#
-
#{w\ 2079}#
-
#{s\ 2080}#
-
#{mod\ 2081}#))
- (cdr
#{body\ 2062}#)))))))))))))))))))
- (begin
- (#{parse\ 2061}#
- (map (lambda (#{x\ 2069}#)
- (cons #{r\ 2044}#
- (#{wrap\ 445}#
- #{x\ 2069}#
- #{w\ 2049}#
- #{mod\ 2036}#)))
- #{body\ 2032}#)
- '()
- '()
- '()
- '()
- '()
- '())))))))))))
- (#{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}#
- ($sc-dispatch
- #{tmp\ 2171}#
- '(_ #(each (any any)) any . each-any))))
- (if #{tmp\ 2172}#
- (@apply
- (lambda (#{id\ 2177}#
- #{val\ 2178}#
- #{e1\ 2179}#
- #{e2\ 2180}#)
- (begin
- (let ((#{ids\ 2182}# #{id\ 2177}#))
- (if (not (#{valid-bound-ids?\ 439}# #{ids\ 2182}#))
- (syntax-violation
- #f
- "duplicate bound keyword"
- #{e\ 2158}#)
- (begin
- (let ((#{labels\ 2185}#
- (#{gen-labels\ 394}# #{ids\ 2182}#)))
- (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}#
- (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}#)
- (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}#))
- (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}#)
- (begin
- (let ((#{p\ 2204}#
- (#{local-eval-hook\ 292}#
- #{expanded\ 2199}#
- #{mod\ 2200}#)))
- (if (procedure? #{p\ 2204}#)
- #{p\ 2204}#
- (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}#
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("i2207"))
- #(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
- chi-top
- syntax-type
- chi-when-list
- chi-install-global
- chi-top-sequence
- chi-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- 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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors
- and-map*)
- ((top) (top) (top) (top))
- ("i40" "i39" "i38" "i36")))
- (hygiene guile)))
- #f)))
- (#{lambda-formals\ 479}#
- (lambda (#{orig-args\ 2210}#)
- (letrec*
- ((#{req\ 2213}#
- (lambda (#{args\ 2216}# #{rreq\ 2217}#)
- (let ((#{tmp\ 2220}# #{args\ 2216}#))
- (let ((#{tmp\ 2221}# ($sc-dispatch #{tmp\ 2220}# '())))
- (if #{tmp\ 2221}#
- (@apply
- (lambda ()
- (#{check\ 2215}# (reverse #{rreq\ 2217}#) #f))
- #{tmp\ 2221}#)
- (let ((#{tmp\ 2222}#
- ($sc-dispatch #{tmp\ 2220}# '(any . any))))
- (if (if #{tmp\ 2222}#
- (@apply
- (lambda (#{a\ 2225}# #{b\ 2226}#)
- (#{id?\ 379}# #{a\ 2225}#))
- #{tmp\ 2222}#)
- #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}#
- (@apply
- (lambda (#{r\ 2233}#)
- (#{id?\ 379}# #{r\ 2233}#))
- #{tmp\ 2231}#)
- #f)
- (@apply
- (lambda (#{r\ 2235}#)
- (#{check\ 2215}#
- (reverse #{rreq\ 2217}#)
- #{r\ 2235}#))
- #{tmp\ 2231}#)
- (let ((#{else\ 2237}# #{tmp\ 2220}#))
- (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)
- (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}#)
- (begin
- (let ((#{ids\ 2265}#
- (if #{rest\ 2251}#
- (append #{req\ 2250}# (list #{rest\ 2251}#))
- #{req\ 2250}#)))
- (begin
- (let ((#{vars\ 2267}#
- (map #{gen-var\ 489}# #{ids\ 2265}#)))
- (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}#)
- #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}#)
- (letrec*
- ((#{req\ 2275}#
- (lambda (#{args\ 2284}# #{rreq\ 2285}#)
- (let ((#{tmp\ 2288}# #{args\ 2284}#))
- (let ((#{tmp\ 2289}# ($sc-dispatch #{tmp\ 2288}# '())))
- (if #{tmp\ 2289}#
- (@apply
- (lambda ()
- (#{check\ 2283}#
- (reverse #{rreq\ 2285}#)
- '()
- #f
- '()))
- #{tmp\ 2289}#)
- (let ((#{tmp\ 2290}#
- ($sc-dispatch #{tmp\ 2288}# '(any . any))))
- (if (if #{tmp\ 2290}#
- (@apply
- (lambda (#{a\ 2293}# #{b\ 2294}#)
- (#{id?\ 379}# #{a\ 2293}#))
- #{tmp\ 2290}#)
- #f)
- (@apply
- (lambda (#{a\ 2297}# #{b\ 2298}#)
- (#{req\ 2275}#
- #{b\ 2298}#
- (cons #{a\ 2297}# #{rreq\ 2285}#)))
- #{tmp\ 2290}#)
- (let ((#{tmp\ 2299}#
- ($sc-dispatch
- #{tmp\ 2288}#
- '(any . any))))
- (if (if #{tmp\ 2299}#
- (@apply
- (lambda (#{a\ 2302}# #{b\ 2303}#)
- (eq? (syntax->datum #{a\ 2302}#)
- #:optional))
- #{tmp\ 2299}#)
- #f)
- (@apply
- (lambda (#{a\ 2306}# #{b\ 2307}#)
- (#{opt\ 2277}#
- #{b\ 2307}#
- (reverse #{rreq\ 2285}#)
- '()))
- #{tmp\ 2299}#)
- (let ((#{tmp\ 2308}#
- ($sc-dispatch
- #{tmp\ 2288}#
- '(any . any))))
- (if (if #{tmp\ 2308}#
- (@apply
- (lambda (#{a\ 2311}# #{b\ 2312}#)
- (eq? (syntax->datum #{a\ 2311}#)
- #:key))
- #{tmp\ 2308}#)
- #f)
- (@apply
- (lambda (#{a\ 2315}# #{b\ 2316}#)
- (#{key\ 2279}#
- #{b\ 2316}#
- (reverse #{rreq\ 2285}#)
- '()
- '()))
- #{tmp\ 2308}#)
- (let ((#{tmp\ 2317}#
- ($sc-dispatch
- #{tmp\ 2288}#
- '(any any))))
- (if (if #{tmp\ 2317}#
- (@apply
- (lambda (#{a\ 2320}#
- #{b\ 2321}#)
- (eq? (syntax->datum
- #{a\ 2320}#)
- #:rest))
- #{tmp\ 2317}#)
- #f)
- (@apply
- (lambda (#{a\ 2324}# #{b\ 2325}#)
- (#{rest\ 2281}#
- #{b\ 2325}#
- (reverse #{rreq\ 2285}#)
- '()
- '()))
- #{tmp\ 2317}#)
- (let ((#{tmp\ 2326}#
- (list #{tmp\ 2288}#)))
- (if (if #{tmp\ 2326}#
- (@apply
- (lambda (#{r\ 2328}#)
- (#{id?\ 379}#
- #{r\ 2328}#))
- #{tmp\ 2326}#)
- #f)
- (@apply
- (lambda (#{r\ 2330}#)
- (#{rest\ 2281}#
- #{r\ 2330}#
- (reverse #{rreq\ 2285}#)
- '()
- '()))
- #{tmp\ 2326}#)
- (let ((#{else\ 2332}#
- #{tmp\ 2288}#))
- (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}#
- (@apply
- (lambda ()
- (#{check\ 2283}#
- #{req\ 2334}#
- (reverse #{ropt\ 2335}#)
- #f
- '()))
- #{tmp\ 2340}#)
- (let ((#{tmp\ 2341}#
- ($sc-dispatch #{tmp\ 2339}# '(any . any))))
- (if (if #{tmp\ 2341}#
- (@apply
- (lambda (#{a\ 2344}# #{b\ 2345}#)
- (#{id?\ 379}# #{a\ 2344}#))
- #{tmp\ 2341}#)
- #f)
- (@apply
- (lambda (#{a\ 2348}# #{b\ 2349}#)
- (#{opt\ 2277}#
- #{b\ 2349}#
- #{req\ 2334}#
- (cons (cons #{a\ 2348}#
- '(#(syntax-object
- #f
- ((top)
- #(ribcage
- #(a b)
- #((top) (top))
- #("i2346" "i2347"))
- #(ribcage () () ())
- #(ribcage
- #(args req ropt)
- #((top) (top) (top))
- #("i2336"
- "i2337"
- "i2338"))
- #(ribcage
- (check rest key opt req)
- ((top)
- (top)
- (top)
- (top)
- (top))
- ("i2282"
- "i2280"
- "i2278"
- "i2276"
- "i2274"))
- #(ribcage
- #(orig-args)
- #((top))
- #("i2273"))
- #(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
- chi-top
- syntax-type
- chi-when-list
- chi-install-global
- chi-top-sequence
- chi-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "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"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors
- and-map*)
- ((top)
- (top)
- (top)
- (top))
- ("i40"
- "i39"
- "i38"
- "i36")))
- (hygiene guile))))
- #{ropt\ 2335}#)))
- #{tmp\ 2341}#)
- (let ((#{tmp\ 2350}#
- ($sc-dispatch
- #{tmp\ 2339}#
- '((any any) . any))))
- (if (if #{tmp\ 2350}#
- (@apply
- (lambda (#{a\ 2354}#
- #{init\ 2355}#
- #{b\ 2356}#)
- (#{id?\ 379}# #{a\ 2354}#))
- #{tmp\ 2350}#)
- #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}#
- ($sc-dispatch
- #{tmp\ 2339}#
- '(any . any))))
- (if (if #{tmp\ 2363}#
- (@apply
- (lambda (#{a\ 2366}# #{b\ 2367}#)
- (eq? (syntax->datum #{a\ 2366}#)
- #:key))
- #{tmp\ 2363}#)
- #f)
- (@apply
- (lambda (#{a\ 2370}# #{b\ 2371}#)
- (#{key\ 2279}#
- #{b\ 2371}#
- #{req\ 2334}#
- (reverse #{ropt\ 2335}#)
- '()))
- #{tmp\ 2363}#)
- (let ((#{tmp\ 2372}#
- ($sc-dispatch
- #{tmp\ 2339}#
- '(any any))))
- (if (if #{tmp\ 2372}#
- (@apply
- (lambda (#{a\ 2375}#
- #{b\ 2376}#)
- (eq? (syntax->datum
- #{a\ 2375}#)
- #:rest))
- #{tmp\ 2372}#)
- #f)
- (@apply
- (lambda (#{a\ 2379}# #{b\ 2380}#)
- (#{rest\ 2281}#
- #{b\ 2380}#
- #{req\ 2334}#
- (reverse #{ropt\ 2335}#)
- '()))
- #{tmp\ 2372}#)
- (let ((#{tmp\ 2381}#
- (list #{tmp\ 2339}#)))
- (if (if #{tmp\ 2381}#
- (@apply
- (lambda (#{r\ 2383}#)
- (#{id?\ 379}#
- #{r\ 2383}#))
- #{tmp\ 2381}#)
- #f)
- (@apply
- (lambda (#{r\ 2385}#)
- (#{rest\ 2281}#
- #{r\ 2385}#
- #{req\ 2334}#
- (reverse #{ropt\ 2335}#)
- '()))
- #{tmp\ 2381}#)
- (let ((#{else\ 2387}#
- #{tmp\ 2339}#))
- (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}#
- (@apply
- (lambda ()
- (#{check\ 2283}#
- #{req\ 2389}#
- #{opt\ 2390}#
- #f
- (cons #f (reverse #{rkey\ 2391}#))))
- #{tmp\ 2397}#)
- (let ((#{tmp\ 2398}#
- ($sc-dispatch #{tmp\ 2396}# '(any . any))))
- (if (if #{tmp\ 2398}#
- (@apply
- (lambda (#{a\ 2401}# #{b\ 2402}#)
- (#{id?\ 379}# #{a\ 2401}#))
- #{tmp\ 2398}#)
- #f)
- (@apply
- (lambda (#{a\ 2405}# #{b\ 2406}#)
- (let ((#{tmp\ 2408}#
- (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-object
- #f
- ((top)
- #(ribcage
- #(k)
- #((top))
- #("i2409"))
- #(ribcage
- #(a b)
- #((top) (top))
- #("i2403"
- "i2404"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(args
- req
- opt
- rkey)
- #((top)
- (top)
- (top)
- (top))
- #("i2392"
- "i2393"
- "i2394"
- "i2395"))
- #(ribcage
- (check rest
- key
- opt
- req)
- ((top)
- (top)
- (top)
- (top)
- (top))
- ("i2282"
- "i2280"
- "i2278"
- "i2276"
- "i2274"))
- #(ribcage
- #(orig-args)
- #((top))
- #("i2273"))
- #(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
- chi-top
- syntax-type
-
chi-when-list
-
chi-install-global
-
chi-top-sequence
- chi-sequence
- source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
- bound-id=?
- free-id=?
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
-
the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
-
subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
- id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
- extend-env
- null-env
-
binding-value
- binding-type
- make-binding
- arg-check
-
source-annotation
- no-source
-
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)
- (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"
- "i420"
- "i419"
- "i418"
- "i416"
- "i415"
- "i414"
- "i413"
- "i412"
- "i410"
- "i408"
- "i406"
- "i404"
- "i402"
- "i400"
- "i398"
- "i396"
- "i393"
- "i391"
- "i390"
- "i389"
- "i388"
- "i387"
- "i386"
- "i385"
- "i384"
- "i383"
- "i381"
- "i380"
- "i378"
- "i376"
- "i374"
- "i372"
- "i370"
- "i368"
- "i366"
- "i365"
- "i364"
- "i363"
- "i362"
- "i361"
- "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"
- "i294"
- "i293"
- "i291"
- "i289"
- "i287"
- "i285"
- "i283"
- "i281"
- "i279"
- "i277"
- "i275"
- "i272"
- "i270"
- "i268"
- "i266"
- "i264"
- "i262"
- "i260"
- "i258"
- "i256"
- "i254"
-