├── .githooks └── pre-commit ├── .github └── workflows │ └── CI.yaml ├── .gitignore ├── .hgignore ├── .travis.yml ├── AUTHORS ├── CMakeLists.txt ├── CONTRIBUTING.md ├── COPYING ├── Makefile ├── Makefile.detect ├── Makefile.libs ├── README-win32.md ├── README.libs ├── README.md ├── RELEASE ├── TODO ├── VERSION ├── appveyor.yml ├── benchmarks ├── gabriel │ ├── chibi-prelude.scm │ ├── conform.sch │ ├── cpstack.sch │ ├── ctak.sch │ ├── dderiv.sch │ ├── deriv.sch │ ├── destruct.sch │ ├── difftimes.sh │ ├── div.sch │ ├── earley.sch │ ├── fft.sch │ ├── graphs.sch │ ├── input.txt │ ├── kanren.sch │ ├── lattice.sch │ ├── lattice2.sch │ ├── maze.sch │ ├── maze2.sch │ ├── mazefun.sch │ ├── nboyer.sch │ ├── nestedloop.sch │ ├── nfa.sch │ ├── nothing.sch │ ├── nqueens.sch │ ├── nucleic2.sch │ ├── paraffins.sch │ ├── peval.sch │ ├── puzzle.sch │ ├── ray.scm │ ├── run.sh │ ├── sboyer.sch │ ├── scheme.sch │ ├── scheme2.sch │ ├── sort1.sch │ ├── tak.sch │ ├── takl.sch │ ├── takr.sch │ ├── takr2.sch │ └── triangle.sch └── shootout │ ├── binarytrees.chibi │ ├── chameneos-redux.chibi │ ├── knucleotide-input.txt │ ├── knucleotide-output.txt │ └── knucleotide.chibi ├── bignum.c ├── build-lib └── chibi │ └── char-set │ ├── compute.scm │ ├── compute.sld │ └── width.sld ├── chibi-scheme.pc.in ├── configure ├── contrib ├── bash_completion ├── chibi-generate-install-meta-helper.cmake ├── chibi-genstatic-helper.cmake ├── chibi-scheme-config.cmake ├── chibi-scheme.pc.cmake.in └── scheme-keywords.el ├── data ├── .gitignore └── .hgignore ├── doc ├── chibi-doc.1 ├── chibi-ffi.1 ├── chibi-scheme.1 ├── chibi.scrbl └── lib │ └── chibi │ └── README ├── eval.c ├── examples ├── echo-server-inet6.scm ├── echo-server-udp.scm ├── echo-server.scm ├── hello.scm ├── repl-server.scm ├── simple-http-client.scm └── simple-http-server.scm ├── fedora.spec ├── gc.c ├── gc_heap.c ├── include └── chibi │ ├── bignum.h │ ├── eval.h │ ├── features.h │ ├── gc_heap.h │ ├── install.h.in │ ├── sexp-huff.h │ ├── sexp-hufftabdefs.h │ ├── sexp-hufftabs.c │ ├── sexp-hufftabs.h │ ├── sexp-unhuff.h │ └── sexp.h ├── js ├── exported_functions.json ├── index.html ├── post.js └── pre.js ├── lib ├── chibi │ ├── accept.c │ ├── app-test.sld │ ├── app.scm │ ├── app.sld │ ├── apropos.scm │ ├── apropos.sld │ ├── assert-test.sld │ ├── assert.sld │ ├── ast.c │ ├── ast.scm │ ├── ast.sld │ ├── base64-test.sld │ ├── base64.scm │ ├── base64.sld │ ├── binary-record-chicken.scm │ ├── binary-record-test.sld │ ├── binary-record.scm │ ├── binary-record.sld │ ├── binary-types.scm │ ├── bytevector-test.sld │ ├── bytevector.scm │ ├── bytevector.sld │ ├── channel.scm │ ├── channel.sld │ ├── char-set.sld │ ├── char-set │ │ ├── ascii.scm │ │ ├── ascii.sld │ │ ├── base.sld │ │ ├── boundary.scm │ │ ├── boundary.sld │ │ ├── extras.scm │ │ ├── extras.sld │ │ ├── full.scm │ │ └── full.sld │ ├── config.scm │ ├── config.sld │ ├── crypto │ │ ├── crypto.stub │ │ ├── md5-test.sld │ │ ├── md5.scm │ │ ├── md5.sld │ │ ├── rsa-test.sld │ │ ├── rsa.scm │ │ ├── rsa.sld │ │ ├── sha2-native.scm │ │ ├── sha2-test.sld │ │ ├── sha2.c │ │ ├── sha2.scm │ │ └── sha2.sld │ ├── csv-test.sld │ ├── csv.scm │ ├── csv.sld │ ├── diff-test.sld │ ├── diff.scm │ ├── diff.sld │ ├── disasm.c │ ├── disasm.sld │ ├── doc-test.sld │ ├── doc.scm │ ├── doc.sld │ ├── edit-distance-test.sld │ ├── edit-distance.sld │ ├── emscripten.scm │ ├── emscripten.sld │ ├── emscripten.stub │ ├── equiv.scm │ ├── equiv.sld │ ├── filesystem-test.sld │ ├── filesystem.scm │ ├── filesystem.sld │ ├── filesystem.stub │ ├── filesystem_win32_shim.c │ ├── generic-test.sld │ ├── generic.scm │ ├── generic.sld │ ├── heap-stats.c │ ├── heap-stats.sld │ ├── highlight.scm │ ├── highlight.sld │ ├── ieee-754.scm │ ├── io-test.sld │ ├── io.sld │ ├── io │ │ ├── io.scm │ │ ├── io.stub │ │ └── port.c │ ├── iset-test.sld │ ├── iset.sld │ ├── iset │ │ ├── base.scm │ │ ├── base.sld │ │ ├── constructors.scm │ │ ├── constructors.sld │ │ ├── iterators.scm │ │ ├── iterators.sld │ │ ├── optimize.scm │ │ └── optimize.sld │ ├── json-test.sld │ ├── json.c │ ├── json.scm │ ├── json.sld │ ├── log-test.sld │ ├── log.scm │ ├── log.sld │ ├── loop-test.sld │ ├── loop.sld │ ├── loop │ │ └── loop.scm │ ├── match-test.sld │ ├── match.sld │ ├── match │ │ └── match.scm │ ├── math │ │ ├── prime-test.sld │ │ ├── prime.scm │ │ └── prime.sld │ ├── memoize-test.sld │ ├── memoize.scm │ ├── memoize.sld │ ├── mime-test.sld │ ├── mime.scm │ ├── mime.sld │ ├── modules.scm │ ├── modules.sld │ ├── monad │ │ ├── environment.scm │ │ └── environment.sld │ ├── net.scm │ ├── net.sld │ ├── net.stub │ ├── net │ │ ├── http-server.scm │ │ ├── http-server.sld │ │ ├── http.scm │ │ ├── http.sld │ │ ├── server-util.scm │ │ ├── server-util.sld │ │ ├── server.scm │ │ ├── server.sld │ │ ├── servlet.scm │ │ └── servlet.sld │ ├── numeric-test.sld │ ├── optimize.scm │ ├── optimize.sld │ ├── optimize │ │ ├── profile.c │ │ ├── profile.scm │ │ ├── profile.sld │ │ ├── rest.c │ │ ├── rest.scm │ │ └── rest.sld │ ├── optional-test.sld │ ├── optional.scm │ ├── optional.sld │ ├── parse-test.sld │ ├── parse.sld │ ├── parse │ │ ├── common.scm │ │ ├── common.sld │ │ └── parse.scm │ ├── pathname-test.sld │ ├── pathname.scm │ ├── pathname.sld │ ├── process-test.sld │ ├── process.scm │ ├── process.sld │ ├── process.stub │ ├── pty-test.sld │ ├── pty.sld │ ├── pty.stub │ ├── quoted-printable-test.sld │ ├── quoted-printable.scm │ ├── quoted-printable.sld │ ├── regexp-test.sld │ ├── regexp.scm │ ├── regexp.sld │ ├── regexp │ │ ├── pcre.scm │ │ └── pcre.sld │ ├── reload.scm │ ├── reload.sld │ ├── repl.scm │ ├── repl.sld │ ├── scribble-test.sld │ ├── scribble.scm │ ├── scribble.sld │ ├── shell-test.sld │ ├── shell.scm │ ├── shell.sld │ ├── show.sld │ ├── show │ │ ├── base.sld │ │ ├── c-test.sld │ │ ├── c.scm │ │ ├── c.sld │ │ ├── color.sld │ │ ├── column.sld │ │ ├── pretty.sld │ │ ├── shared.sld │ │ └── unicode.sld │ ├── signal.c │ ├── snow │ │ ├── commands.scm │ │ ├── commands.sld │ │ ├── fort.scm │ │ ├── fort.sld │ │ ├── interface.scm │ │ ├── interface.sld │ │ ├── package.scm │ │ ├── package.sld │ │ ├── utils.scm │ │ └── utils.sld │ ├── string-test.sld │ ├── string.scm │ ├── string.sld │ ├── stty.scm │ ├── stty.sld │ ├── stty.stub │ ├── sxml-test.sld │ ├── sxml.scm │ ├── sxml.sld │ ├── syntax-case-test.sld │ ├── syntax-case.scm │ ├── syntax-case.sld │ ├── system-test.sld │ ├── system.sld │ ├── system.stub │ ├── tar-test.sld │ ├── tar.scm │ ├── tar.sld │ ├── temp-file.scm │ ├── temp-file.sld │ ├── term │ │ ├── ansi-test.sld │ │ ├── ansi.scm │ │ ├── ansi.sld │ │ ├── edit-line.scm │ │ └── edit-line.sld │ ├── test.scm │ ├── test.sld │ ├── text-test.sld │ ├── text.sld │ ├── text │ │ ├── base.scm │ │ ├── base.sld │ │ ├── marks.scm │ │ ├── movement.scm │ │ ├── search.scm │ │ ├── search.sld │ │ ├── types.scm │ │ ├── types.sld │ │ ├── utf8.scm │ │ └── utf8.sld │ ├── time.sld │ ├── time.stub │ ├── trace.scm │ ├── trace.sld │ ├── type-inference.scm │ ├── type-inference.sld │ ├── uri-test.sld │ ├── uri.scm │ ├── uri.sld │ ├── weak-test.sld │ ├── weak.c │ ├── weak.sld │ ├── win32 │ │ ├── process-win32.scm │ │ ├── process-win32.sld │ │ └── process-win32.stub │ ├── zlib.scm │ └── zlib.sld ├── init-7.scm ├── meta-7.scm ├── scheme │ ├── base.sld │ ├── bitwise.sld │ ├── box.sld │ ├── bytevector-test.sld │ ├── bytevector.sld │ ├── bytevector.stub │ ├── case-lambda.sld │ ├── char.sld │ ├── char │ │ ├── ascii.scm │ │ ├── case-offsets.scm │ │ ├── full.scm │ │ ├── normalization.sld │ │ └── special-casing.scm │ ├── charset.sld │ ├── comparator.sld │ ├── complex.sld │ ├── cxr.scm │ ├── cxr.sld │ ├── define-values.scm │ ├── digit-value.scm │ ├── division.scm │ ├── division.sld │ ├── ephemeron.sld │ ├── eval.sld │ ├── extras.scm │ ├── file.sld │ ├── fixnum.sld │ ├── flonum.sld │ ├── generator.sld │ ├── hash-table.sld │ ├── ideque.sld │ ├── ilist.sld │ ├── inexact.scm │ ├── inexact.sld │ ├── lazy.sld │ ├── list-queue.sld │ ├── list.sld │ ├── load.sld │ ├── lseq.sld │ ├── mapping.sld │ ├── mapping │ │ └── hash.sld │ ├── misc-macros.scm │ ├── process-context.sld │ ├── r5rs.sld │ ├── read.sld │ ├── red.sld │ ├── regex.sld │ ├── repl.sld │ ├── rlist.sld │ ├── set.sld │ ├── show.sld │ ├── small.sld │ ├── sort.sld │ ├── stream.sld │ ├── text.sld │ ├── time.c │ ├── time.sld │ ├── time │ │ ├── tai-to-utc-offset.sld │ │ └── tai.sld │ ├── vector.sld │ ├── vector │ │ ├── base.sld │ │ ├── c128.sld │ │ ├── c64.sld │ │ ├── f32.sld │ │ ├── f64.sld │ │ ├── s16.sld │ │ ├── s32.sld │ │ ├── s64.sld │ │ ├── s8.sld │ │ ├── u16.sld │ │ ├── u32.sld │ │ ├── u64.sld │ │ └── u8.sld │ └── write.sld └── srfi │ ├── 1 │ ├── alists.scm │ ├── constructors.scm │ ├── deletion.scm │ ├── fold.scm │ ├── immutable.sld │ ├── lset.scm │ ├── misc.scm │ ├── predicates.scm │ ├── search.scm │ ├── selectors.scm │ └── test.sld │ ├── 2 │ └── test.sld │ ├── 14 │ └── test.sld │ ├── 16 │ └── test.sld │ ├── 18 │ ├── interface.scm │ ├── test.sld │ ├── threads.c │ └── types.scm │ ├── 26 │ └── test.sld │ ├── 27 │ ├── constructors.scm │ ├── rand.c │ └── test.sld │ ├── 33 │ └── test.sld │ ├── 35 │ ├── internal.scm │ ├── internal.sld │ └── test.sld │ ├── 38 │ └── test.sld │ ├── 39 │ ├── param.c │ ├── syntax-no-threads.scm │ └── syntax.scm │ ├── 41 │ └── test.sld │ ├── 69 │ ├── hash.c │ ├── interface.scm │ ├── test.sld │ └── type.scm │ ├── 95 │ ├── qsort.c │ ├── sort.scm │ └── test.sld │ ├── 98 │ └── env.c │ ├── 99 │ ├── records.sld │ ├── records │ │ ├── inspection.scm │ │ ├── inspection.sld │ │ ├── procedural.scm │ │ ├── procedural.sld │ │ ├── syntactic.scm │ │ └── syntactic.sld │ └── test.sld │ ├── 101 │ └── test.sld │ ├── 113 │ ├── bags.scm │ ├── sets.scm │ └── test.sld │ ├── 116 │ └── test.sld │ ├── 117 │ ├── queue.scm │ └── test.sld │ ├── 121 │ ├── generators.scm │ └── test.sld │ ├── 125 │ ├── hash.scm │ └── test.sld │ ├── 127 │ └── test.sld │ ├── 128 │ ├── 162-impl.scm │ ├── comparators.scm │ └── test.sld │ ├── 129 │ ├── test.sld │ ├── titlecase.scm │ └── titlemaps.scm │ ├── 130 │ └── test.sld │ ├── 132 │ ├── sort.scm │ └── test.sld │ ├── 133 │ ├── test.sld │ └── vector.scm │ ├── 134 │ └── test.sld │ ├── 135 │ ├── kernel8.body.scm │ ├── kernel8.sld │ └── test.sld │ ├── 139 │ └── test.sld │ ├── 143 │ ├── fixnum.scm │ └── test.sld │ ├── 144 │ ├── flonum.scm │ ├── lgamma_r.c │ ├── math.stub │ └── test.sld │ ├── 146 │ ├── hamt-map-test.scm │ ├── hamt-map-test.sld │ ├── hamt-map.scm │ ├── hamt-map.sld │ ├── hamt-misc-test.scm │ ├── hamt-misc-test.sld │ ├── hamt-misc.scm │ ├── hamt-misc.sld │ ├── hamt-test.scm │ ├── hamt-test.sld │ ├── hamt.scm │ ├── hamt.sld │ ├── hash-test.sld │ ├── hash.scm │ ├── hash.sld │ ├── mapping.scm │ ├── rbtree.scm │ ├── test.sld │ ├── vector-edit-test.scm │ ├── vector-edit-test.sld │ ├── vector-edit.scm │ └── vector-edit.sld │ ├── 151 │ ├── bit.c │ ├── bitwise.scm │ └── test.sld │ ├── 158 │ └── test.sld │ ├── 159 │ ├── base.scm │ ├── base.sld │ ├── color.sld │ ├── columnar.sld │ └── unicode.sld │ ├── 160 │ ├── base.sld │ ├── c128.sld │ ├── c64.sld │ ├── f16.sld │ ├── f32.sld │ ├── f64.sld │ ├── f8.sld │ ├── mini-test.sld │ ├── mini.sld │ ├── prims.sld │ ├── s16.sld │ ├── s32.sld │ ├── s64.sld │ ├── s8.sld │ ├── test.sld │ ├── u16.sld │ ├── u32.sld │ ├── u64.sld │ ├── u8.sld │ ├── uvector.scm │ ├── uvector.sld │ └── uvprims.stub │ ├── 166 │ ├── base.scm │ ├── base.sld │ ├── color.scm │ ├── color.sld │ ├── column.scm │ ├── columnar.sld │ ├── pretty.scm │ ├── pretty.sld │ ├── show.scm │ ├── test.sld │ ├── unicode.scm │ ├── unicode.sld │ ├── width.scm │ └── write.scm │ ├── 179 │ ├── base.scm │ ├── base.sld │ ├── test.sld │ └── transforms.scm │ ├── 211 │ ├── identifier-syntax.sld │ ├── test.sld │ └── variable-transformer.sld │ ├── 219 │ └── test.sld │ ├── 227 │ └── definition.sld │ ├── 229 │ └── test.sld │ ├── 231 │ ├── base.scm │ ├── base.sld │ ├── test.sld │ └── transforms.scm │ ├── 1.sld │ ├── 101.scm │ ├── 101.sld │ ├── 11.sld │ ├── 111.sld │ ├── 113.sld │ ├── 115.sld │ ├── 116.sld │ ├── 117.sld │ ├── 121.sld │ ├── 124.sld │ ├── 125.sld │ ├── 127.scm │ ├── 127.sld │ ├── 128.sld │ ├── 129.sld │ ├── 130.scm │ ├── 130.sld │ ├── 132.sld │ ├── 133.sld │ ├── 134.scm │ ├── 134.sld │ ├── 135.scm │ ├── 135.sld │ ├── 139.scm │ ├── 139.sld │ ├── 14.sld │ ├── 141.sld │ ├── 142.sld │ ├── 143.sld │ ├── 144.sld │ ├── 145.sld │ ├── 146.sld │ ├── 147.sld │ ├── 151.sld │ ├── 154.scm │ ├── 154.sld │ ├── 158.scm │ ├── 158.sld │ ├── 159.sld │ ├── 16.sld │ ├── 165.scm │ ├── 165.sld │ ├── 166.sld │ ├── 179.sld │ ├── 18.sld │ ├── 188.sld │ ├── 193.sld │ ├── 2.sld │ ├── 219.sld │ ├── 227.sld │ ├── 229.sld │ ├── 23.sld │ ├── 231.sld │ ├── 26.sld │ ├── 27.sld │ ├── 33.sld │ ├── 35.sld │ ├── 38.scm │ ├── 38.sld │ ├── 39.sld │ ├── 41.scm │ ├── 41.sld │ ├── 46.sld │ ├── 55.sld │ ├── 6.sld │ ├── 64.scm │ ├── 64.sld │ ├── 69.sld │ ├── 8.sld │ ├── 9.scm │ ├── 9.sld │ ├── 95.sld │ ├── 98.sld │ └── 99.sld ├── main.c ├── mkfile ├── opcodes.c ├── opt ├── fcall.c ├── opcode_names.h └── plan9-opcodes.c ├── plan9.c ├── sexp.c ├── simplify.c ├── tests ├── basic │ ├── test00-fact-3.res │ ├── test00-fact-3.scm │ ├── test01-apply.res │ ├── test01-apply.scm │ ├── test02-closure.res │ ├── test02-closure.scm │ ├── test03-nested-closure.res │ ├── test03-nested-closure.scm │ ├── test04-nested-let.res │ ├── test04-nested-let.scm │ ├── test05-internal-define.res │ ├── test05-internal-define.scm │ ├── test06-letrec.res │ ├── test06-letrec.scm │ ├── test07-mutation.res │ ├── test07-mutation.scm │ ├── test08-callcc.res │ ├── test08-callcc.scm │ ├── test09-hygiene.res │ ├── test09-hygiene.scm │ ├── test10-unhygiene.res │ └── test10-unhygiene.scm ├── build │ ├── build-opts.txt │ └── build-tests.sh ├── division-tests.scm ├── ffi │ └── ffi-tests.scm ├── foreign │ ├── apply-loop.c │ └── typeid.c ├── install │ ├── install-tests.pl │ └── run-install-test.sh ├── lib-tests.scm ├── memory │ ├── memory-tests.sh │ ├── test00-read-string.err-res │ ├── test00-read-string.res │ ├── test00-read-string.scm │ ├── test01-read-symbol.err-res │ ├── test01-read-symbol.res │ └── test01-read-symbol.scm ├── r5rs-tests.scm ├── r7rs-tests.scm ├── re-tests.txt ├── run │ ├── command-line-tests.sh │ ├── lib │ │ ├── fact.sld │ │ ├── fib.scm │ │ └── hello.sld │ ├── test00-p.args │ ├── test00-p.res │ ├── test01-p-short.args │ ├── test01-p-short.res │ ├── test02-h.args │ ├── test02-h.res │ ├── test03-q.args │ ├── test03-q.res │ ├── test04-Q.args │ ├── test04-Q.res │ ├── test05-xscheme-r5rs.args │ ├── test05-xscheme-r5rs.res │ ├── test06-xscheme-base.args │ ├── test06-xscheme-base.res │ ├── test07-xchibi.args │ ├── test07-xchibi.res │ ├── test08-xchibi-primitive.args │ ├── test08-xchibi-primitive.res │ ├── test09-m.args │ ├── test09-m.res │ ├── test10-xscheme-base-m.args │ ├── test10-xscheme-base-m.res │ ├── test11-xscheme-r5rs-m.args │ ├── test11-xscheme-r5rs-m.res │ ├── test12-xchibi-m.args │ ├── test12-xchibi-m.res │ ├── test13-A-m.args │ ├── test13-A-m.res │ ├── test14-R.args │ ├── test14-R.res │ ├── test15-R-args.args │ ├── test15-R-args.res │ ├── test16-R-r.args │ ├── test16-R-r.res │ ├── test17-R-r-args.args │ ├── test17-R-r-args.res │ ├── test18-t.args │ ├── test18-t.err-res │ ├── test18-t.res │ ├── test19-l.args │ └── test19-l.res ├── snow │ ├── repo0 │ │ └── edouard │ │ │ └── lucas.sld │ ├── repo1 │ │ └── leonardo │ │ │ ├── fibonacci-test.scm │ │ │ ├── fibonacci.scm │ │ │ └── fibonacci.sld │ ├── repo2 │ │ └── leonardo │ │ │ ├── fibonacci-test.scm │ │ │ ├── fibonacci.scm │ │ │ └── fibonacci.sld │ ├── repo3 │ │ ├── pingala │ │ │ ├── binomial-impl.scm │ │ │ ├── binomial-test.scm │ │ │ ├── binomial.scm │ │ │ ├── factorial.scm │ │ │ ├── ganas.txt │ │ │ ├── prosody-test.sld │ │ │ ├── prosody.sld │ │ │ ├── test-map.scm │ │ │ └── triangle.scm │ │ ├── pythagoras │ │ │ ├── hyp.c │ │ │ ├── hypotenuse-test.sch │ │ │ ├── hypotenuse.sch │ │ │ └── hypotenuse.stub │ │ ├── recorde │ │ │ ├── equal-test.sld │ │ │ └── equal.sld │ │ ├── takakazu │ │ │ ├── bernoulli-includes.sld │ │ │ ├── bernoulli-test.scm │ │ │ ├── bernoulli.scm │ │ │ └── bernoulli.sld │ │ ├── totient-impl.scm │ │ ├── totient-test.scm │ │ └── totient.scm │ ├── repo4 │ │ ├── VERSION │ │ ├── config.scm │ │ └── euler │ │ │ ├── exponential-include.sld │ │ │ ├── exponential-test.sld │ │ │ ├── exponential.scm │ │ │ ├── exponential.sld │ │ │ ├── interest-test.sld │ │ │ └── interest.sld │ ├── repo5 │ │ └── repo.scm │ └── snow-tests.scm ├── syntax-tests.scm └── unicode-tests.scm ├── tools ├── chibi-doc ├── chibi-ffi ├── chibi-gdb ├── chibi-genstatic ├── chibi-run ├── chibi-save ├── extract-case-offsets.scm ├── extract-special-casing.scm ├── extract-unicode-props.scm ├── generate-install-meta.scm ├── optimize-char-sets.scm ├── snow-chibi └── snow-chibi.scm └── vm.c /.githooks/pre-commit: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if git rev-parse --verify HEAD >/dev/null 2>&1; then 4 | against=HEAD 5 | else 6 | # Initial commit: diff against an empty tree object 7 | against=4b825dc642cb6eb9a060e54bf8d69288fbee4904 8 | fi 9 | 10 | # fail if we add any new lines to C or Scheme source containing a tab 11 | if git diff --name-only "$against" | egrep -q '\.(cpp|h|scm|sld|stub)$' &&\ 12 | git diff --name-only "$against" |\ 13 | egrep '\.(cpp|h|scm|sld|stub)$' |\ 14 | xargs -d'\n' git diff -U0 --no-color "$against" -- |\ 15 | grep -q $'^+ *\t'; then 16 | echo "Error: Attempting to add a source file using tabs for indentation." 17 | echo 18 | echo -n " " 19 | git diff --name-only "$against" |\ 20 | egrep '\.(cpp|h|scm|sld|stub)$' |\ 21 | xargs -d'\n' git diff -U0 "$against" -- |\ 22 | grep $'^+ *\t' | head -1 23 | echo 24 | cat <char-set "0123456789abcdefABCDEF")))) 10 | 11 | (define char-set:iso-control 12 | (immutable-char-set 13 | (char-set-union (ucs-range->char-set 0 #x20) 14 | (ucs-range->char-set #x7F #xA0)))) 15 | 16 | (define char-set:graphic 17 | (immutable-char-set 18 | (char-set-union 19 | char-set:letter char-set:digit char-set:punctuation char-set:symbol))) 20 | 21 | (define char-set:printing 22 | (immutable-char-set (char-set-union char-set:whitespace char-set:graphic))) 23 | -------------------------------------------------------------------------------- /build-lib/chibi/char-set/compute.sld: -------------------------------------------------------------------------------- 1 | 2 | ;; Don't import this - it's temporarily used to compute optimized 3 | ;; char-set representations. 4 | 5 | (define-library (chibi char-set compute) 6 | (import (chibi) (chibi iset) (chibi char-set)) 7 | (include "derived.scm" "compute.scm") 8 | (export 9 | char-set:lower-case 10 | char-set:upper-case 11 | char-set:title-case 12 | char-set:letter 13 | char-set:punctuation 14 | char-set:symbol 15 | char-set:blank 16 | char-set:whitespace 17 | char-set:digit 18 | char-set:letter+digit 19 | char-set:hex-digit 20 | char-set:iso-control 21 | char-set:graphic 22 | char-set:printing)) 23 | -------------------------------------------------------------------------------- /build-lib/chibi/char-set/width.sld: -------------------------------------------------------------------------------- 1 | 2 | ;; Don't import this - it's temporarily used to compute optimized 3 | ;; char-set representations. 4 | 5 | (define-library (chibi char-set width) 6 | (import (chibi) (chibi iset) (chibi char-set)) 7 | (include "width.scm") 8 | (export 9 | char-set:zero-width 10 | char-set:full-width 11 | char-set:ambiguous-width 12 | )) 13 | -------------------------------------------------------------------------------- /chibi-scheme.pc.in: -------------------------------------------------------------------------------- 1 | Name: chibi-scheme 2 | URL: http://synthcode.com/scheme/chibi/ 3 | Description: Minimal Scheme Implementation for use as an Extension Language 4 | Version: ${version} 5 | Libs: -L${libdir} -lchibi-scheme 6 | Libs.private: -dl -lm 7 | Cflags: -I${includedir} 8 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | echo "Autoconf is an evil piece bloatware encouraging cargo-cult programming." 4 | echo "Make, on the other hand, is a beautiful little prolog for the filesystem." 5 | echo "Just run 'make'." 6 | -------------------------------------------------------------------------------- /contrib/chibi-generate-install-meta-helper.cmake: -------------------------------------------------------------------------------- 1 | 2 | execute_process( 3 | COMMAND find ${LIBDIR} -name "*.sld" 4 | COMMAND ${EXEC} ${GENMETA} ${VERSION} 5 | OUTPUT_FILE ${OUT} 6 | RESULT_VARIABLE error) 7 | 8 | if(error) 9 | message(FATAL_ERROR "${error}") 10 | endif() 11 | -------------------------------------------------------------------------------- /contrib/chibi-genstatic-helper.cmake: -------------------------------------------------------------------------------- 1 | # 2 | # chibi-genstatic-helper.cmake 3 | # 4 | # INPUT: 5 | # ROOT= 6 | # EXEC= 7 | # GENSTATIC= 8 | # STUBS= 9 | # OUT= 10 | if(NOT EXEC) 11 | message(FATAL_ERROR "huh?") 12 | endif() 13 | 14 | if(NOT OUT) 15 | message(FATAL_ERROR "huh?") 16 | endif() 17 | 18 | execute_process( 19 | COMMAND ${EXEC} ${GENSTATIC} --no-inline 20 | INPUT_FILE ${STUBS} 21 | OUTPUT_FILE ${OUT} 22 | RESULT_VARIABLE rr 23 | ) 24 | 25 | if(rr) 26 | message(FATAL_ERROR "Error: ${rr}") 27 | endif() 28 | -------------------------------------------------------------------------------- /contrib/chibi-scheme-config.cmake: -------------------------------------------------------------------------------- 1 | 2 | include(${CMAKE_CURRENT_LIST_DIR}/chibi-scheme-targets.cmake) 3 | -------------------------------------------------------------------------------- /contrib/chibi-scheme.pc.cmake.in: -------------------------------------------------------------------------------- 1 | # pkg-config 2 | prefix=@CMAKE_INSTALL_PREFIX@ 3 | exec_prefix=@CMAKE_INSTALL_FULL_BINDIR@ 4 | libdir=@CMAKE_INSTALL_FULL_LIBDIR@ 5 | includedir=@CMAKE_INSTALL_FULL_INCLUDEDIR@ 6 | version=@CMAKE_PROJECT_VERSION@ 7 | 8 | Name: chibi-scheme 9 | URL: http://synthcode.com/scheme/chibi/ 10 | Description: Minimal Scheme Implementation for use as an Extension Language 11 | Version: ${version} 12 | Libs: -L${libdir} -lchibi-scheme 13 | Libs.private: -dl -lm 14 | Cflags: -I${includedir} 15 | -------------------------------------------------------------------------------- /data/.gitignore: -------------------------------------------------------------------------------- 1 | # downloaded unicode standard files 2 | *.txt 3 | -------------------------------------------------------------------------------- /data/.hgignore: -------------------------------------------------------------------------------- 1 | syntax: glob 2 | *.txt 3 | -------------------------------------------------------------------------------- /doc/chibi-doc.1: -------------------------------------------------------------------------------- 1 | .TH "chibi-doc" "1" "" "" 2 | .UC 4 3 | .SH NAME 4 | .PP 5 | chibi-doc \- generate docs from Scheme scribble syntax 6 | 7 | .SH SYNOPSIS 8 | .B chibi-doc 9 | [-hst] 10 | [ 11 | .I file 12 | ] 13 | .BR 14 | 15 | .B chibi-doc 16 | .I dotted-name.of.module 17 | [ 18 | .I identifier 19 | ] 20 | .BR 21 | .SP 0.4 22 | 23 | .SH DESCRIPTION 24 | .I chibi-doc 25 | is a tool to generate documentation from the Scheme scribble syntax 26 | from Racket. It works like a Unix filter, translating from the 27 | current input or a file to standard output. You can also specify a 28 | module name, with components separated with dots, and it will search 29 | for the module and generate documentation from it automatically from 30 | literate comments in the module or any of its source files. These 31 | comments are any line beginning with the characters 32 | .I ;;> 33 | 34 | The scribble syntax is described in the manual. 35 | 36 | .SH OPTIONS 37 | .TP 5 38 | .BI -h 39 | Outputs in HTML format (the default). 40 | .TP 41 | .BI -s 42 | Outputs in SXML format. 43 | .TP 44 | .BI -t 45 | Outputs in text format (the default for describing a single variable). 46 | 47 | .SH AUTHORS 48 | .PP 49 | Alex Shinn (alexshinn @ gmail . com) 50 | 51 | .SH SEE ALSO 52 | .PP 53 | The chibi-scheme home-page: 54 | .BR 55 | https://github.com/ashinn/chibi-scheme/ 56 | -------------------------------------------------------------------------------- /doc/chibi-ffi.1: -------------------------------------------------------------------------------- 1 | .TH "chibi-ffi" "1" "" "" 2 | .UC 4 3 | .SH NAME 4 | .PP 5 | chibi-ffi \- generate C from Scheme stub files 6 | 7 | .SH SYNOPSIS 8 | .B chibi-ffi 9 | [-c] 10 | [-f 11 | .I 12 | cflags 13 | ] 14 | input.stub 15 | [ 16 | .I output.c 17 | ] 18 | .BR 19 | .SP 0.4 20 | 21 | .SH DESCRIPTION 22 | .I chibi-ffi 23 | reads in the C function FFI definitions from an input file and outputs 24 | the appropriate C wrappers into a file with the same base name and the 25 | ".c" extension. You can then compile that C file into a shared 26 | library: 27 | 28 | chibi-ffi file.stub 29 | cc -fPIC -shared file.c -lchibi-scheme 30 | 31 | If the -c option is specified then chibi-ffi attempts to compile the 32 | generated C code for you in one step. In this case, additional flags 33 | for the C compiler may be given with the -f option. 34 | 35 | The FFI syntax is described in the manual. 36 | 37 | .SH AUTHORS 38 | .PP 39 | Alex Shinn (alexshinn @ gmail . com) 40 | 41 | .SH SEE ALSO 42 | .PP 43 | The chibi-scheme home-page: 44 | .BR 45 | https://github.com/ashinn/chibi-scheme/ 46 | -------------------------------------------------------------------------------- /doc/lib/chibi/README: -------------------------------------------------------------------------------- 1 | Auto-generated module documentation with tools/chibi-doc. 2 | -------------------------------------------------------------------------------- /examples/echo-server-inet6.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env chibi-scheme 2 | 3 | (import (scheme base) (scheme write) (chibi net) (chibi net server)) 4 | 5 | ;; Copy each input line to output. 6 | (define (echo-handler in out sock addr) 7 | (let ((line (read-line in))) 8 | (cond 9 | ((not (or (eof-object? line) (equal? line ""))) 10 | ;; log the request to stdout 11 | (display "read: ") (write line) 12 | (display " from ") 13 | (display (sockaddr-name (address-info-address addr))) 14 | (display " port ") (write (sockaddr-port (address-info-address addr))) 15 | (newline) 16 | ;; write and flush the response 17 | (display line out) 18 | (newline out) 19 | (flush-output-port out) 20 | (echo-handler in out sock addr))))) 21 | 22 | (define (get-inet6-address-info host service) 23 | (let ((hints (make-address-info address-family/inet6 24 | socket-type/stream 25 | ip-proto/tcp))) 26 | (get-address-info host service hints))) 27 | 28 | ;; Start the server on local ipv6 addresses on port 5556. 29 | (run-net-server (get-inet6-address-info #f 5556) echo-handler) 30 | -------------------------------------------------------------------------------- /examples/echo-server-udp.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env chibi-scheme 2 | 3 | (import (scheme base) (chibi net)) 4 | 5 | (define (get-udp-address-info host service) 6 | (let ((hints (make-address-info address-family/inet 7 | socket-type/datagram 8 | ip-proto/udp))) 9 | (get-address-info host service hints))) 10 | 11 | ;; create and bind a udp socket 12 | (let* ((addr (get-udp-address-info #f 5556)) 13 | (sock (socket (address-info-family addr) 14 | (address-info-socket-type addr) 15 | (address-info-protocol addr)))) 16 | (bind sock (address-info-address addr) (address-info-address-length addr)) 17 | ;; for every packet we receive, just send it back 18 | (let lp () 19 | (cond 20 | ((receive sock 512 0 addr) 21 | => (lambda (bv) (send sock bv 0 addr)))) 22 | (lp))) 23 | -------------------------------------------------------------------------------- /examples/echo-server.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env chibi-scheme 2 | 3 | ;; Simple R7RS echo server, using the run-net-server utility from 4 | ;; (chibi net server). 5 | 6 | (import (scheme base) (scheme write) (chibi net) (chibi net server)) 7 | 8 | ;; Copy each input line to output. 9 | (define (echo-handler in out sock addr) 10 | (let ((line (read-line in))) 11 | (cond 12 | ((not (or (eof-object? line) (equal? line ""))) 13 | ;; log the request to stdout 14 | (display "read: ") (write line) 15 | (display " from ") 16 | (display (sockaddr-name (address-info-address addr))) 17 | (display ":") (write (sockaddr-port (address-info-address addr))) 18 | (newline) 19 | ;; write and flush the response 20 | (display line out) 21 | (newline out) 22 | (flush-output-port out) 23 | (echo-handler in out sock addr))))) 24 | 25 | ;; Start the server on *:5556 dispatching clients to echo-handler. 26 | (run-net-server 5556 echo-handler) 27 | -------------------------------------------------------------------------------- /examples/hello.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base)) 2 | 3 | (write-string "Hello world!\n") 4 | -------------------------------------------------------------------------------- /examples/repl-server.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env chibi-scheme 2 | 3 | (import (scheme base) (scheme read) (scheme write) (scheme eval) 4 | (chibi net) (chibi net server)) 5 | 6 | (define (repl-handler in out sock addr) 7 | (let ((env (environment '(scheme base) 8 | '(only (chibi) import)))) 9 | (let lp () 10 | (let ((expr (read in))) 11 | (cond 12 | ((not (eof-object? expr)) 13 | (let ((result (guard (exn (else 14 | (display "ERROR: " out) 15 | (write exn out) 16 | (newline out) 17 | (if #f #f))) 18 | (eval expr env)))) 19 | (cond 20 | ((not (eq? result (if #f #f))) 21 | (write result out) 22 | (newline out))) 23 | (flush-output-port out) 24 | (lp)))))))) 25 | 26 | (run-net-server 5556 repl-handler) 27 | -------------------------------------------------------------------------------- /examples/simple-http-client.scm: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env chibi-scheme 2 | 3 | ; Simple HTTP client 4 | ; Retrieves the contents of the URL argument: 5 | 6 | ; Usage: 7 | ; simple-http-client.scm [URL] 8 | ; 9 | ; Example: 10 | ; simple-http-client.scm http://localhost:8000 11 | 12 | (import (chibi) (chibi net) (chibi net http) (chibi io)) 13 | 14 | (if (> (length (command-line)) 1) 15 | (let ((url (car (cdr (command-line))))) 16 | (if (> (string-length url) 0) 17 | (begin 18 | (display (read-string 65536 (http-get url))) 19 | (newline)))) 20 | (let ((progname (car (command-line)))) 21 | (display "Retrieve the contents of a URL.") 22 | (newline) 23 | (display "Usage:") 24 | (newline) 25 | (newline) 26 | (display progname) 27 | (display " [URL]") 28 | (newline))) 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /examples/simple-http-server.scm: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env chibi-scheme 2 | 3 | ; Simple HTTP server 4 | ; Returns a minimal HTML page with a single number incremented 5 | ; every request. Binds to localhost port 8000. 6 | 7 | (import (chibi) (chibi net http-server) (chibi net servlet) (chibi sxml)) 8 | 9 | (let ((count 0)) 10 | (run-http-server 11 | 8000 12 | (lambda (cfg request next restart) 13 | (set! count (+ 1 count)) 14 | (servlet-write request (sxml->xml `(html (body 15 | (p "Count: \n") 16 | (p ,count)))))))) 17 | -------------------------------------------------------------------------------- /include/chibi/install.h.in: -------------------------------------------------------------------------------- 1 | #define sexp_so_extension "@CMAKE_SHARED_LIBRARY_SUFFIX@" 2 | #define sexp_default_module_path "@default_module_path@" 3 | #define sexp_platform "@platform@" 4 | #define sexp_architecture "@CMAKE_SYSTEM_PROCESSOR@" 5 | #define sexp_version "@CMAKE_PROJECT_VERSION@" 6 | #define sexp_release_name "@release@" 7 | -------------------------------------------------------------------------------- /include/chibi/sexp-hufftabdefs.h: -------------------------------------------------------------------------------- 1 | 2 | extern char _huff_tab1[8], _huff_tab2[8], _huff_tab3[2], _huff_tab4[2], 3 | _huff_tab5[4], _huff_tab6[2], _huff_tab7[4], _huff_tab8[4], 4 | _huff_tab9[4], _huff_tab10[4], _huff_tab11[4], _huff_tab12[2], 5 | _huff_tab13[8], _huff_tab14[2], _huff_tab15[8], _huff_tab16[8], 6 | _huff_tab17[8], _huff_tab18[8], _huff_tab19[4], _huff_tab20[8], 7 | _huff_tab21[8]; 8 | -------------------------------------------------------------------------------- /js/exported_functions.json: -------------------------------------------------------------------------------- 1 | [ 2 | "_main", 3 | "_sexp_resume" 4 | ] 5 | -------------------------------------------------------------------------------- /js/post.js: -------------------------------------------------------------------------------- 1 | Module['resume'] = Module.cwrap('sexp_resume', 'void', []); 2 | 3 | -------------------------------------------------------------------------------- /js/pre.js: -------------------------------------------------------------------------------- 1 | Module['preRun'].push(function () { 2 | FS.writeFile('program.scm', Module['program']); 3 | }); 4 | Module['arguments'] = Module['arguments'] || []; 5 | Module['arguments'].unshift('program.scm'); 6 | 7 | -------------------------------------------------------------------------------- /lib/chibi/app.sld: -------------------------------------------------------------------------------- 1 | ;;> Unified command-line option parsing and config management. 2 | 3 | (define-library (chibi app) 4 | (export parse-option parse-options parse-app run-application 5 | app-help app-help-command) 6 | (import (scheme base) 7 | (scheme read) 8 | (scheme write) 9 | (scheme process-context) 10 | (srfi 1) 11 | (chibi config) 12 | (chibi edit-distance) 13 | (chibi string)) 14 | (include "app.scm")) 15 | -------------------------------------------------------------------------------- /lib/chibi/apropos.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi apropos) 2 | (export apropos apropos-list) 3 | (import (scheme base) (chibi) (chibi string) (srfi 1) (srfi 95)) 4 | (include "apropos.scm")) 5 | -------------------------------------------------------------------------------- /lib/chibi/assert-test.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi assert-test) 3 | (import (chibi) (chibi assert) (chibi test)) 4 | (export run-tests) 5 | (begin 6 | (define-syntax test-assert 7 | (syntax-rules () 8 | ((test-assert irritants expr) 9 | (protect (exn 10 | (else 11 | (test irritants (exception-irritants exn)))) 12 | expr 13 | (error "assertion not triggered"))))) 14 | (define (run-tests) 15 | (test-begin "assert") 16 | (test-assert '((= x (+ x 1)) 17 | (x 3)) 18 | (let ((x 3)) (assert (= x (+ x 1))))) 19 | (test-assert '((= x (+ y 1)) 20 | (x 3) 21 | (y 42)) 22 | (let ((x 3) (y 42)) (assert (= x (+ y 1))))) 23 | (test-assert '((eq? x 'three) 24 | (x 3)) 25 | (let ((x 3)) (assert (eq? x 'three)))) 26 | (test-assert '((eq? x 'three) 27 | "expected three: " 28 | 3) 29 | (let ((x 3)) (assert (eq? x 'three) "expected three: " x))) 30 | (test-end)))) 31 | -------------------------------------------------------------------------------- /lib/chibi/base64.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi base64) 3 | (export base64-encode base64-encode-string base64-encode-bytevector 4 | base64-decode base64-decode-string base64-decode-bytevector 5 | base64-encode-header) 6 | (import (scheme base) 7 | (chibi string)) 8 | (cond-expand 9 | ((library (srfi 151)) 10 | (import (srfi 151))) 11 | ((library (srfi 33)) 12 | (import (srfi 33)) 13 | (begin 14 | (define (%mask size) (bitwise-not (arithmetic-shift -1 size))) 15 | (define (bit-field n start end) 16 | (bitwise-and (arithmetic-shift n (- start)) (mask (- end start)))))) 17 | (else 18 | (import (srfi 60)) 19 | (begin 20 | (define (%mask size) (bitwise-not (arithmetic-shift -1 size))) 21 | (define (bit-field n start end) 22 | (bitwise-and (arithmetic-shift n (- start)) (mask (- end start))))))) 23 | (cond-expand 24 | (chibi (import (chibi io))) 25 | (else 26 | (begin 27 | (define (port->string in) 28 | (let ((out (open-output-string))) 29 | (let lp () 30 | (let ((ch (read-char in))) 31 | (cond 32 | ((eof-object? ch) 33 | (get-output-string out)) 34 | (else 35 | (write-char ch out) 36 | (lp)))))))))) 37 | (include "base64.scm")) 38 | -------------------------------------------------------------------------------- /lib/chibi/binary-record-test.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi binary-record-test) 3 | (export run-tests) 4 | (import (scheme base) (chibi binary-record) (chibi test)) 5 | (begin 6 | (define-binary-record-type gif-header 7 | (make: make-gif-header) 8 | (pred: gif-header?) 9 | (read: read-gif-header) 10 | (write: write-gif-header) 11 | (block: 12 | "GIF89a" 13 | (width (u16/le) gif-header-width) 14 | (height (u16/le) gif-header-height) 15 | (gct (u8) gif-header-gct) 16 | (bgcolor (u8) gif-header-gbcolor) 17 | (aspect-ratio (u8) gif-header-aspect-ratio) 18 | )) 19 | (define (gif->bytevector gif) 20 | (let ((out (open-output-bytevector))) 21 | (write-gif-header gif out) 22 | (get-output-bytevector out))) 23 | (define (bytevector->gif bv) 24 | (read-gif-header (open-input-bytevector bv))) 25 | (define (run-tests) 26 | (test-begin "(chibi binary-record)") 27 | (let ((gif (make-gif-header 4096 2160 #xF7 1 2))) 28 | (test #u8(#x47 #x49 #x46 #x38 #x39 #x61 0 #x10 #x70 #x08 #xF7 #x01 #x02) 29 | (gif->bytevector gif)) 30 | (test gif (bytevector->gif (gif->bytevector gif)))) 31 | (test-end)))) 32 | -------------------------------------------------------------------------------- /lib/chibi/channel.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi channel) 3 | (cond-expand 4 | (chibi (import (chibi) (srfi 9))) 5 | (else (import (scheme base)))) 6 | (import (srfi 18)) 7 | (export Channel make-channel channel? channel-empty? 8 | channel-send! channel-receive!) 9 | (include "channel.scm")) 10 | -------------------------------------------------------------------------------- /lib/chibi/char-set.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> A minimal character set library. 3 | 4 | (define-library (chibi char-set) 5 | (import (chibi char-set base) (chibi char-set extras)) 6 | (export 7 | Char-Set char-set? char-set-contains? 8 | char-set ucs-range->char-set char-set-copy char-set-size 9 | char-set-fold char-set-for-each 10 | list->char-set char-set->list string->char-set char-set->string 11 | char-set-adjoin! char-set-adjoin char-set-union char-set-union! 12 | char-set-intersection char-set-intersection! 13 | char-set-difference char-set-difference! 14 | immutable-char-set char-set-complement 15 | char-set:empty char-set:ascii char-set:full)) 16 | -------------------------------------------------------------------------------- /lib/chibi/char-set/ascii.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi char-set ascii) 3 | (import (chibi) (chibi iset base) (chibi char-set base)) 4 | (export char-set:lower-case char-set:upper-case char-set:title-case 5 | char-set:letter char-set:digit char-set:letter+digit 6 | char-set:graphic char-set:printing char-set:whitespace 7 | char-set:iso-control char-set:punctuation char-set:symbol 8 | char-set:hex-digit char-set:blank) 9 | (include "ascii.scm")) 10 | -------------------------------------------------------------------------------- /lib/chibi/char-set/base.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi char-set base) 3 | (cond-expand 4 | (chibi 5 | (import (chibi)) 6 | (begin 7 | (define-syntax immutable-char-set 8 | (sc-macro-transformer 9 | (lambda (expr use-env) 10 | (eval (cadr expr) use-env)))))) 11 | (else 12 | (import (scheme base)) 13 | (begin 14 | (define-syntax immutable-char-set 15 | (syntax-rules () ((immutable-char-set cs) cs)))))) 16 | (import (chibi iset base)) 17 | (export (rename Integer-Set Char-Set) 18 | (rename iset? char-set?) 19 | immutable-char-set 20 | char-set-contains?) 21 | (begin 22 | (define (char-set-contains? cset ch) 23 | (iset-contains? cset (char->integer ch))))) 24 | -------------------------------------------------------------------------------- /lib/chibi/char-set/boundary.sld: -------------------------------------------------------------------------------- 1 | ;; Character sets for Unicode boundaries, TR29. 2 | ;; This code is written by Alex Shinn and placed in the 3 | ;; Public Domain. All warranties are disclaimed. 4 | 5 | ;;> Char-sets used for 6 | ;;> \hyperlink["http://unicode.org/reports/tr29/"]{TR29} word 7 | ;;> boundaries. 8 | 9 | (define-library (chibi char-set boundary) 10 | (cond-expand 11 | (chibi (import (chibi))) 12 | (else (import (scheme base)))) 13 | (cond-expand 14 | ((library (chibi char-set)) (import (chibi char-set))) 15 | (else 16 | (import (srfi 14)) 17 | (begin (define (immutable-char-set cs) cs)))) 18 | (export char-set:regional-indicator 19 | char-set:extend-or-spacing-mark 20 | char-set:hangul-l 21 | char-set:hangul-v 22 | char-set:hangul-t 23 | char-set:hangul-lv 24 | char-set:hangul-lvt) 25 | ;; generated with: 26 | ;; tools/extract-unicode-props.scm --derived GraphemeBreakProperty.txt 27 | ;; Control extend-or-spacing-mark=Extend,SpacingMark Regional_Indicator 28 | ;; hangul-l=:L hangul-v=:V hangul-t=:T hangul-lv=:LV hangul-lvt=:LVT 29 | (include "boundary.scm")) 30 | -------------------------------------------------------------------------------- /lib/chibi/char-set/extras.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi char-set extras) 3 | (cond-expand 4 | (chibi (import (chibi))) 5 | (else (import (scheme base)))) 6 | (import (chibi iset) (chibi char-set base)) 7 | (include "extras.scm") 8 | (export 9 | char-set ucs-range->char-set char-set-copy char-set-size 10 | char-set-fold char-set-for-each 11 | list->char-set char-set->list string->char-set char-set->string 12 | char-set-adjoin! char-set-adjoin char-set-union char-set-union! 13 | char-set-intersection char-set-intersection! 14 | char-set-difference char-set-difference! 15 | char-set-complement char-set:empty char-set:ascii char-set:full)) 16 | -------------------------------------------------------------------------------- /lib/chibi/char-set/full.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi char-set full) 3 | (import (chibi) (chibi iset base) (chibi char-set base)) 4 | (export char-set:lower-case char-set:upper-case char-set:title-case 5 | char-set:letter char-set:digit char-set:letter+digit 6 | char-set:graphic char-set:printing char-set:whitespace 7 | char-set:iso-control char-set:punctuation char-set:symbol 8 | char-set:hex-digit char-set:blank) 9 | (include "full.scm")) 10 | -------------------------------------------------------------------------------- /lib/chibi/config.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi config) 3 | (export make-conf conf? conf-load conf-load-in-path conf-load-cascaded 4 | conf-verify conf-extend conf-append conf-set conf-unfold-key 5 | conf-get conf-get-list conf-get-cdr conf-get-multi 6 | conf-specialize read-from-file conf-source conf-head conf-parent 7 | assoc-get assoc-get-list) 8 | (import (scheme base) (scheme read) (scheme write) (scheme file) 9 | (scheme time) (srfi 1)) 10 | ;; This is only used for config verification, it's acceptable to 11 | ;; substitute file existence for the stronger directory check. 12 | (cond-expand 13 | (chibi 14 | (import (only (meta) warn)) 15 | (import (only (chibi) print-exception print-stack-trace)) 16 | (import (only (chibi filesystem) file-directory?))) 17 | (else 18 | (begin 19 | (define file-directory? file-exists?) 20 | (define (print-exception exn) (write exn)) 21 | (define (print-stack-trace . o) #f) 22 | (define (warn msg . args) 23 | (let ((err (current-error-port))) 24 | (display msg err) 25 | (for-each (lambda (x) (display " " err) (write x err)) args) 26 | (newline err)))))) 27 | (include "config.scm")) 28 | -------------------------------------------------------------------------------- /lib/chibi/crypto/md5-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi crypto md5-test) 2 | (export run-tests) 3 | (import (scheme base) (chibi crypto md5) (chibi test)) 4 | (begin 5 | (define (run-tests) 6 | (test-begin "md5") 7 | (test "d41d8cd98f00b204e9800998ecf8427e" 8 | (md5 "")) 9 | (test "900150983cd24fb0d6963f7d28e17f72" 10 | (md5 "abc")) 11 | (test "9e107d9d372bb6826bd81d3542a419d6" 12 | (md5 "The quick brown fox jumps over the lazy dog")) 13 | (test-end)))) 14 | -------------------------------------------------------------------------------- /lib/chibi/crypto/md5.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Implementation of the MD5 (Message Digest) cryptographic hash. In 3 | ;;> new applications SHA-2 should be preferred. 4 | 5 | (define-library (chibi crypto md5) 6 | (import (scheme base) (chibi bytevector)) 7 | (cond-expand 8 | ((library (srfi 151)) (import (srfi 151))) 9 | ((library (srfi 33)) (import (srfi 33))) 10 | (else (import (srfi 60)))) 11 | (export md5) 12 | (include "md5.scm")) 13 | -------------------------------------------------------------------------------- /lib/chibi/crypto/rsa.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> RSA public key cryptography implementation. 3 | 4 | (define-library (chibi crypto rsa) 5 | (import (scheme base) (srfi 27) 6 | (chibi bytevector) (chibi math prime)) 7 | (cond-expand 8 | ((library (srfi 151)) (import (srfi 151))) 9 | ((library (srfi 33)) (import (srfi 33))) 10 | (else (import (srfi 60)))) 11 | (export make-rsa-key rsa-key-gen rsa-key-gen-from-primes rsa-pub-key 12 | rsa-encrypt rsa-decrypt rsa-sign rsa-verify rsa-verify? 13 | rsa-key? rsa-key-bits rsa-key-n rsa-key-e rsa-key-d 14 | pkcs1-pad pkcs1-unpad) 15 | (include "rsa.scm")) 16 | -------------------------------------------------------------------------------- /lib/chibi/crypto/sha2-native.scm: -------------------------------------------------------------------------------- 1 | ;; sha2-native.scm -- SHA-2 digest algorithms native interface 2 | ;; Copyright (c) 2015 Alexei Lozovsky. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (process-sha-data! context src) 6 | (cond ((or (bytevector? src) (string? src)) 7 | (add-sha-data! context src)) 8 | ((input-port? src) 9 | (let lp ((chunk (read-bytevector 1024 src))) 10 | (unless (eof-object? chunk) 11 | (add-sha-data! context chunk) 12 | (lp (read-bytevector 1024 src))))) 13 | (else 14 | (error "unknown digest source: " src)))) 15 | 16 | (define (sha-224 src) 17 | (let ((context (start-sha type-sha-224))) 18 | (process-sha-data! context src) 19 | (get-sha context))) 20 | 21 | (define (sha-256 src) 22 | (let ((context (start-sha type-sha-256))) 23 | (process-sha-data! context src) 24 | (get-sha context))) 25 | -------------------------------------------------------------------------------- /lib/chibi/crypto/sha2.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Implementation of the SHA-2 (Secure Hash Algorithm) cryptographic 3 | ;;> hash. 4 | 5 | (define-library (chibi crypto sha2) 6 | (import (scheme base)) 7 | (export sha-224 sha-256) 8 | (cond-expand 9 | (chibi 10 | (include "sha2-native.scm") 11 | (include-shared "crypto")) 12 | (else 13 | (cond-expand 14 | ((library (srfi 151)) (import (srfi 151))) 15 | ((library (srfi 33)) (import (srfi 33))) 16 | (else (import (srfi 60)))) 17 | (import (chibi bytevector)) 18 | (include "sha2.scm")))) 19 | 20 | ;;> \procedure{(sha-224 src)} 21 | ;;> 22 | ;;> Computes SHA-224 digest of the \var{src} which can be a string, 23 | ;;> a bytevector, or a binary input port. Returns a hexadecimal string 24 | ;;> (in lowercase). 25 | 26 | ;;> \procedure{(sha-256 src)} 27 | ;;> 28 | ;;> Computes SHA-256 digest of the \var{src} which can be a string, 29 | ;;> a bytevector, or a binary input port. Returns a hexadecimal string 30 | ;;> (in lowercase). 31 | -------------------------------------------------------------------------------- /lib/chibi/csv.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi csv) 3 | (import (scheme base) (scheme write) (srfi 130) (srfi 227)) 4 | (export csv-grammar csv-parser csv-grammar? 5 | default-csv-grammar default-tsv-grammar 6 | csv-read->list csv-read->vector csv-read->fixed-vector 7 | csv-read->sxml csv-num-rows 8 | csv-fold csv-map csv->list csv-for-each csv->sxml 9 | csv-writer csv-write 10 | csv-skip-line) 11 | (include "csv.scm")) 12 | -------------------------------------------------------------------------------- /lib/chibi/diff.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi diff) 3 | (import (scheme base) (srfi 1) (chibi optional) (chibi term ansi)) 4 | (export lcs lcs-with-positions 5 | diff write-diff diff->string 6 | write-edits edits->string edits->string/color 7 | write-line-diffs 8 | write-line-diffs/color 9 | write-char-diffs 10 | write-char-diffs/color) 11 | (cond-expand 12 | (chibi (import (only (chibi io) port->list))) 13 | (else 14 | (begin 15 | (define (port->list reader port) 16 | (let lp ((res '())) 17 | (let ((x (reader port))) 18 | (if (eof-object? x) 19 | (reverse res) 20 | (lp (cons x res))))))))) 21 | (include "diff.scm")) 22 | -------------------------------------------------------------------------------- /lib/chibi/disasm.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> \subsubsubsection{\scheme{(disasm f [out])}} 3 | 4 | ;;> Write a human-readable disassembly for the procedure \var{f} to 5 | ;;> the port \var{out}, defaulting to \scheme{(current-output-port)}. 6 | 7 | (define-library (chibi disasm) 8 | (export disasm) 9 | (import (chibi)) 10 | (include-shared "disasm")) 11 | -------------------------------------------------------------------------------- /lib/chibi/doc.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi doc) 3 | (import 4 | (except (chibi) eval) (scheme eval) (srfi 1) (srfi 39) (srfi 95) 5 | (chibi modules) (chibi ast) (chibi io) (chibi match) 6 | (chibi time) (chibi filesystem) (chibi process) (chibi pathname) 7 | (chibi string) (chibi scribble) (chibi sxml) (chibi highlight) 8 | (chibi type-inference)) 9 | (export procedure-docs print-procedure-docs 10 | print-module-docs print-module-binding-docs 11 | generate-docs expand-docs fixup-docs 12 | extract-module-docs extract-module-file-docs extract-file-docs 13 | make-default-doc-env make-module-doc-env 14 | get-optionals-signature 15 | ansi->sxml) 16 | (include "doc.scm")) 17 | -------------------------------------------------------------------------------- /lib/chibi/edit-distance-test.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi edit-distance-test) 3 | (export run-tests) 4 | (import (scheme base) (chibi edit-distance) (chibi test)) 5 | (begin 6 | (define (run-tests) 7 | (test-begin "(chibi edit-distance)") 8 | (test 0 (edit-distance "" "")) 9 | (test 0 (edit-distance "same" "same")) 10 | (test 1 (edit-distance "same" "game")) 11 | (test 2 (edit-distance "same" "sand")) 12 | (test 3 (edit-distance "kitten" "sitting")) 13 | (test 3 (edit-distance "Saturday" "Sunday")) 14 | (test-end)))) 15 | -------------------------------------------------------------------------------- /lib/chibi/emscripten.scm: -------------------------------------------------------------------------------- 1 | (define (wait-on-event!) (%call/cc abort)) 2 | 3 | -------------------------------------------------------------------------------- /lib/chibi/emscripten.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi emscripten) 2 | (cond-expand 3 | (emscripten 4 | (import (chibi) (chibi ast)) 5 | (export eval-script! integer-eval-script string-eval-script 6 | wait-on-event!) 7 | (include "emscripten.scm") 8 | (include-shared "emscripten")))) 9 | -------------------------------------------------------------------------------- /lib/chibi/emscripten.stub: -------------------------------------------------------------------------------- 1 | (cond-expand 2 | (emscripten 3 | (c-system-include "emscripten.h") 4 | 5 | (define-c void (eval-script! "emscripten_run_script") (string)) 6 | (define-c int (integer-eval-script "emscripten_run_script_int") (string)) 7 | (define-c string (string-eval-script "emscripten_run_script_string") (string)))) 8 | -------------------------------------------------------------------------------- /lib/chibi/equiv.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi equiv) 3 | (export equiv?) 4 | (import (chibi)) 5 | (import (srfi 69)) 6 | (include "equiv.scm")) 7 | -------------------------------------------------------------------------------- /lib/chibi/generic-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi generic-test) 2 | (export run-tests) 3 | (import (chibi) (chibi generic) (chibi test)) 4 | (begin 5 | (define (run-tests) 6 | (test-begin "generics") 7 | 8 | (let () 9 | (define-generic add) 10 | (define-method (add (x number?) (y number?)) 11 | (+ x y)) 12 | (define-method (add (x string?) (y string?)) 13 | (string-append x y)) 14 | (define-method (add x (y list?)) 15 | (append x y)) 16 | (test 4 (add 2 2)) 17 | (test "22" (add "2" "2")) 18 | (test '(2 2) (add '() '(2 2))) 19 | (test '(2 2) (add '(2) '(2))) 20 | (test '(2 2) (add '(2 2) '())) 21 | (test '(2) (add #f '(2))) 22 | (test-error (add #(2) #(2)))) 23 | 24 | (let () 25 | (define-generic mul) 26 | (define-method (mul (x number?) (y number?)) 27 | (* x y)) 28 | (define-method (mul (x inexact?) (y inexact?)) 29 | (+ (* x y) 0.1)) 30 | (define-method (mul (x exact?) (y exact?)) 31 | (inexact->exact (call-next-method))) 32 | (test 21 (mul 3 7)) 33 | (test 21.0 (mul 3.0 7)) 34 | (test 21.0 (mul 3 7.0)) 35 | (test 21.1 (mul 3.0 7.0))) 36 | 37 | (test-end)))) 38 | -------------------------------------------------------------------------------- /lib/chibi/generic.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Simple generic function interface. 3 | 4 | (define-library (chibi generic) 5 | (export define-generic define-method make-generic generic-add!) 6 | (import (chibi)) 7 | (include "generic.scm")) 8 | -------------------------------------------------------------------------------- /lib/chibi/heap-stats.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Utilities for gathering statistics on the heap. Just measuring 3 | ;;> runtime memory usage doesn't give a good idea of how to optimize 4 | ;;> that usage, so this module is provided for profiling. 5 | 6 | ;;> \procedure{(heap-stats)} 7 | 8 | ;;> Returns an alist summarizing all heap allocated objects. The 9 | ;;> \var{car} of each cell is the type-name, and the \var{cdr} is the 10 | ;;> count of objects of that type in the heap. Garbage is collected 11 | ;;> before the counts are taken. 12 | 13 | ;;> \procedure{(heap-dump [depth])} 14 | 15 | ;;> Returns the same value as \scheme{(heap-stats)}, but also prints 16 | ;;> all objects on the heap as it runs. \var{depth} indicates the 17 | ;;> printing depth for compound objects and defaults to 1. 18 | 19 | ;;> These functions just return \scheme{'()} when using the Boehm GC. 20 | 21 | (define-library (chibi heap-stats) 22 | (export heap-stats heap-sizes heap-dump free-sizes) 23 | (import (chibi)) 24 | (include-shared "heap-stats")) 25 | -------------------------------------------------------------------------------- /lib/chibi/highlight.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi highlight) 3 | (export highlight highlight-detect-language highlighter-for highlight-style 4 | highlight-scheme highlight-c highlight-assembly) 5 | (import (chibi) (srfi 1) (chibi io)) 6 | (include "highlight.scm")) 7 | -------------------------------------------------------------------------------- /lib/chibi/io.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi io) 3 | (export read-string read-string! read-line write-line %%read-line 4 | port-fold port-fold-right port-map 5 | port->list port->string-list port->sexp-list 6 | port->string port->bytevector 7 | file->string file->bytevector 8 | file-position set-file-position! seek/set seek/cur seek/end 9 | make-custom-input-port make-custom-output-port 10 | make-custom-binary-input-port make-custom-binary-output-port 11 | make-null-output-port make-null-input-port 12 | make-broadcast-port make-concatenated-port 13 | make-generated-input-port make-generated-binary-input-port 14 | make-filtered-output-port make-filtered-input-port 15 | string-count-chars 16 | open-input-bytevector open-output-bytevector get-output-bytevector 17 | string->utf8 string->utf8! string-offset utf8->string utf8->string! 18 | utf8-ref utf8-next utf8-prev 19 | write-string write-u8 read-u8 peek-u8 send-file 20 | is-a-socket? 21 | call-with-input-file call-with-output-file) 22 | (import (chibi) (chibi ast)) 23 | (include-shared "io/io") 24 | (include "io/io.scm")) 25 | -------------------------------------------------------------------------------- /lib/chibi/iset.sld: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2004-2015 Alex Shinn. All rights reserved. 2 | ;; BSD-style license: http://synthcode.com/license.txt 3 | 4 | ;;> A space efficient integer set (iset) implementation, optimized for 5 | ;;> minimal space usage and fast membership lookup. General set 6 | ;;> operations are provided based on the character set operations 7 | ;;> found in SRFI-14. 8 | 9 | (define-library (chibi iset) 10 | (import (scheme base) 11 | (chibi iset base) 12 | (chibi iset iterators) 13 | (chibi iset constructors)) 14 | (export 15 | %make-iset make-iset iset? iset-contains? Integer-Set 16 | iset iset-copy list->iset list->iset! 17 | iset-adjoin iset-adjoin! iset-delete iset-delete! 18 | iset-union iset-union! iset-intersection iset-intersection! 19 | iset-difference iset-difference! 20 | iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node 21 | iset-map iset->list iset-size iset= iset<= iset>= 22 | iset-cursor iset-cursor? iset-cursor-next iset-ref end-of-iset? 23 | iset-rank iset-select)) 24 | -------------------------------------------------------------------------------- /lib/chibi/iset/base.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi iset base) 3 | (cond-expand 4 | (chibi (import (chibi) (srfi 9))) 5 | (else (import (scheme base)))) 6 | (cond-expand 7 | ((library (srfi 151)) (import (srfi 151))) 8 | ((library (srfi 33)) (import (srfi 33))) 9 | (else (import (srfi 60)))) 10 | (include "base.scm") 11 | (cond-expand ;; workaround for #1342 12 | (chicken (begin (define Integer-Set #f))) 13 | (else)) 14 | (export 15 | %make-iset make-iset iset? iset-contains? Integer-Set 16 | iset-start iset-end iset-bits iset-left iset-right 17 | iset-start-set! iset-end-set! iset-bits-set! iset-left-set! iset-right-set!)) 18 | -------------------------------------------------------------------------------- /lib/chibi/iset/constructors.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi iset constructors) 3 | (cond-expand 4 | (chibi (import (chibi))) 5 | (else (import (scheme base)))) 6 | (import (chibi iset base) (chibi iset iterators)) 7 | (cond-expand 8 | ((library (srfi 151)) (import (srfi 151))) 9 | ((library (srfi 33)) (import (srfi 33))) 10 | (else (import (srfi 60)))) 11 | (include "constructors.scm") 12 | (export 13 | iset iset-copy list->iset list->iset! iset-map 14 | iset-adjoin iset-adjoin! iset-delete iset-delete! 15 | iset-union iset-union! iset-intersection iset-intersection! 16 | iset-difference iset-difference! 17 | ;; low-level 18 | iset-copy-node iset-squash-bits! iset-insert-left! iset-insert-right!)) 19 | -------------------------------------------------------------------------------- /lib/chibi/iset/iterators.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi iset iterators) 3 | (cond-expand 4 | (chibi (import (chibi) (srfi 9))) 5 | (else (import (scheme base)))) 6 | (import (chibi iset base)) 7 | (cond-expand 8 | ((library (srfi 151)) (import (srfi 151))) 9 | ((library (srfi 33)) (import (srfi 33))) 10 | (else (import (srfi 60)))) 11 | (include "iterators.scm") 12 | (export 13 | iset-empty? iset-fold iset-fold-node iset-for-each iset-for-each-node 14 | iset->list iset-size iset= iset<= iset>= 15 | ;; rank/select 16 | iset-rank iset-select 17 | ;; low-level cursors 18 | iset-cursor iset-cursor? iset-cursor-next iset-ref end-of-iset?)) 19 | -------------------------------------------------------------------------------- /lib/chibi/iset/optimize.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi iset optimize) 3 | (cond-expand 4 | (chibi (import (chibi) (srfi 9))) 5 | (else (import (scheme base)))) 6 | (import (chibi iset base) 7 | (chibi iset iterators) 8 | (chibi iset constructors)) 9 | (cond-expand 10 | ((library (srfi 151)) (import (srfi 151))) 11 | ((library (srfi 33)) (import (srfi 33))) 12 | (else 13 | (import (srfi 60)) 14 | (begin 15 | (define (%mask size) (bitwise-not (arithmetic-shift -1 size))) 16 | (define (extract-bit-field size position n) 17 | (bitwise-and (%mask size) (arithmetic-shift n (- position))))))) 18 | (include "optimize.scm") 19 | (export 20 | iset-balance iset-balance! iset-optimize iset-optimize! 21 | iset->code iset->code/lambda)) 22 | -------------------------------------------------------------------------------- /lib/chibi/json.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi json) 3 | (import (scheme base) 4 | (except (srfi 99 records) define-record-type) 5 | (only (chibi ast) type-name) 6 | (only (chibi) make-constructor)) 7 | (export string->json json->string json-read json-write 8 | make-json-reader) 9 | (include-shared "json") 10 | (include "json.scm")) 11 | -------------------------------------------------------------------------------- /lib/chibi/loop.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi loop) 3 | (export loop for in-list in-lists in-port in-file up-from down-from 4 | listing listing-reverse appending appending-reverse 5 | summing multiplying in-string in-string-reverse in-substrings 6 | in-vector in-vector-reverse) 7 | (import (chibi)) 8 | (include "loop/loop.scm")) 9 | -------------------------------------------------------------------------------- /lib/chibi/match.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi match) 3 | (export match match-lambda match-lambda* match-let match-letrec match-let*) 4 | (cond-expand 5 | (chibi (import (chibi))) 6 | (else (import (scheme base)))) 7 | (include "match/match.scm")) 8 | -------------------------------------------------------------------------------- /lib/chibi/math/prime.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi math prime) 3 | (import (scheme base) (scheme inexact) (chibi optional) (srfi 1) (srfi 27)) 4 | (cond-expand 5 | ((library (srfi 151)) (import (srfi 151))) 6 | ((library (srfi 33)) (import (srfi 33))) 7 | (else (import (srfi 60)))) 8 | (export prime? nth-prime prime-above prime-below 9 | factor factor-alist perfect? 10 | totient aliquot 11 | provable-prime? probable-prime? 12 | random-prime random-prime-distinct-from 13 | coprime? random-coprime modular-inverse modular-expt 14 | miller-rabin-composite?) 15 | (include "prime.scm")) 16 | -------------------------------------------------------------------------------- /lib/chibi/memoize.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi memoize) 3 | (import (chibi optional) (chibi pathname) (chibi string) 4 | (srfi 9) (srfi 38) (srfi 69) (srfi 98)) 5 | (cond-expand 6 | (chibi 7 | (import (chibi) (chibi ast) (chibi system) (chibi filesystem)) 8 | (begin 9 | (define (i-am-root?) 10 | (zero? (current-user-id))))) 11 | (else 12 | (import (scheme base) (scheme char) (scheme file)) 13 | (begin 14 | (define (i-am-root?) 15 | (equal? "root" (get-environment-variable "USER"))) 16 | (define (procedure-name x) #f) 17 | (define (procedure-arity x) #f) 18 | (define (procedure-variadic? x) #f)))) 19 | (export define-memoized memoize memoize-to-file memoize-file-loader 20 | make-lru-cache lru-cache? lru-ref lru-ref! lru-set! 21 | hash-table-ref!) 22 | (include "memoize.scm")) 23 | -------------------------------------------------------------------------------- /lib/chibi/mime.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi mime) 3 | (export assq-ref mime-header-fold mime-headers->list 4 | mime-parse-content-type mime-decode-header 5 | mime-message-fold mime-message->sxml mime-write-headers 6 | mime-type-from-extension) 7 | (import (scheme base) (scheme char) (scheme write) 8 | (chibi base64) (chibi quoted-printable) 9 | (chibi string)) 10 | (include "mime.scm")) 11 | -------------------------------------------------------------------------------- /lib/chibi/modules.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi modules) 3 | (export module? module-name module-dir module-includes module-shared-includes 4 | module-include-library-declarations module-meta-data 5 | module-ast module-ast-set! module-ref module-contains? 6 | analyze-module containing-module load-module module-exports 7 | module-name->file module-lib-dir procedure-analysis find-module 8 | available-modules-in-directory available-modules 9 | modules-exporting-identifier file->sexp-list) 10 | (import (chibi) 11 | (srfi 1) 12 | (chibi ast) 13 | (chibi pathname) 14 | (chibi filesystem) 15 | (chibi string) 16 | (only (meta) 17 | module-env module-meta-data module-exports 18 | make-module load-module find-module resolve-import 19 | resolve-module-imports 20 | module-name-prefix 21 | module-name->file 22 | *modules*)) 23 | (include "modules.scm")) 24 | -------------------------------------------------------------------------------- /lib/chibi/monad/environment.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi monad environment) 3 | (export define-environment-monad) 4 | (import (scheme base)) 5 | (cond-expand 6 | (chibi (import (only (chibi) syntax-quote))) 7 | (else (begin (define-syntax syntax-quote (syntax-rules ((_ x) 'x)))))) 8 | (include "environment.scm")) 9 | -------------------------------------------------------------------------------- /lib/chibi/net/http-server.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi net http-server) 3 | (export 4 | ;; main interface 5 | run-http-server 6 | ;; basic servlets 7 | http-chain-servlets http-default-servlet http-wrap-default 8 | http-file-servlet http-procedure-servlet http-ext-servlet 9 | http-regexp-servlet http-path-regexp-servlet http-uri-regexp-servlet 10 | http-host-regexp-servlet http-redirect-servlet http-rewrite-servlet 11 | http-cgi-bin-dir-servlet http-scheme-script-dir-servlet 12 | http-send-file) 13 | (import 14 | (scheme time) (srfi 39) (srfi 95) 15 | (chibi) (chibi mime) (chibi regexp) (chibi pathname) (chibi uri) 16 | (chibi filesystem) (chibi io) (chibi string) (chibi process) 17 | (chibi net) (chibi net server) (chibi net server-util) (chibi net servlet) 18 | (chibi app) (chibi ast) (chibi config) (chibi log) (chibi memoize) 19 | (chibi temp-file)) 20 | (include "http-server.scm")) 21 | -------------------------------------------------------------------------------- /lib/chibi/net/server-util.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi net server-util) 3 | (import (chibi) (chibi io) (chibi net) (chibi string) (chibi uri) 4 | (chibi process) (chibi time) (chibi pathname) (chibi filesystem) 5 | (chibi temp-file) 6 | (srfi 69) (srfi 151)) 7 | (export line-handler command-handler parse-command 8 | get-host file-mime-type) 9 | (include "server-util.scm")) 10 | -------------------------------------------------------------------------------- /lib/chibi/net/server.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi net server) 3 | (import (chibi) (chibi net) (chibi filesystem) (chibi log) 4 | (srfi 18) (srfi 98)) 5 | (export run-net-server make-listener-thunk) 6 | (include "server.scm")) 7 | -------------------------------------------------------------------------------- /lib/chibi/net/servlet.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi net servlet) 3 | (export 4 | ;; uploads 5 | upload? upload-name upload-filename 6 | upload-headers upload->string upload-input-port upload-save 7 | upload->bytevector upload->sexp upload-binary-input-port 8 | ;; requests 9 | request? request-method request-host request-uploads 10 | request-uri request-version request-headers request-body request-params 11 | request-in request-out request-sock request-addr request-param 12 | request-method-set! request-host-set! request-uri-set! 13 | request-version-set! request-headers-set! request-body-set! 14 | request-params-set! request-in-set! request-out-set! 15 | request-sock-set! request-addr-set! 16 | request-param request-param-list request-upload request-upload-list 17 | request-uri-string request-with-uri request-path 18 | copy-request make-request make-cgi-request 19 | ;; servlets 20 | servlet-write servlet-write-status servlet-respond servlet-parse-body! 21 | make-status-servlet servlet-handler servlet-run 22 | servlet-bad-request) 23 | (import 24 | (scheme base) (scheme read) (scheme write) (scheme file) 25 | (srfi 9) (srfi 39) (srfi 69) (srfi 98) 26 | (chibi ast) (chibi io) (chibi uri) (chibi mime) (chibi log) (chibi config) 27 | (chibi filesystem) (chibi net) (chibi net server-util)) 28 | (include "servlet.scm")) 29 | -------------------------------------------------------------------------------- /lib/chibi/optimize.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi optimize) 3 | (import (chibi) (chibi ast) (chibi match) (srfi 1)) 4 | (export register-lambda-optimization! 5 | replace-references 6 | fold-every join-seq dotted-tail) 7 | (include "optimize.scm")) 8 | -------------------------------------------------------------------------------- /lib/chibi/optimize/profile.c: -------------------------------------------------------------------------------- 1 | /* profile.c -- low-level utilities for VM profiling */ 2 | /* Copyright (c) 2011 Alex Shinn. All rights reserved. */ 3 | /* BSD-style license: http://synthcode.com/license.txt */ 4 | 5 | #include 6 | 7 | static sexp sexp_increment_cdr (sexp ctx, sexp self, sexp_sint_t n, sexp pair) { 8 | sexp_assert_type(ctx, sexp_pairp, SEXP_PAIR, pair); 9 | sexp_cdr(pair) = sexp_make_fixnum(1 + sexp_unbox_fixnum(sexp_cdr(pair))); 10 | return SEXP_VOID; 11 | } 12 | 13 | sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) { 14 | if (!(sexp_version_compatible(ctx, version, sexp_version) 15 | && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER))) 16 | return SEXP_ABI_ERROR; 17 | sexp_define_foreign(ctx, env, "increment-cdr!", 1, sexp_increment_cdr); 18 | return SEXP_VOID; 19 | } 20 | -------------------------------------------------------------------------------- /lib/chibi/optimize/profile.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi optimize profile) 3 | (export optimize-profile increment-cdr! profile-reset profile-report) 4 | (import (chibi) (srfi 1) (srfi 69) (srfi 95) 5 | (chibi ast) (chibi match) (chibi optimize)) 6 | (include-shared "profile") 7 | (include "profile.scm")) 8 | -------------------------------------------------------------------------------- /lib/chibi/optimize/rest.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi optimize rest) 3 | (export optimize-rest rest-parameter-cdrs num-parameters local-ref) 4 | (import (chibi) (srfi 1) (chibi ast) (chibi match) (chibi optimize)) 5 | (include-shared "rest") 6 | (include "rest.scm")) 7 | -------------------------------------------------------------------------------- /lib/chibi/parse/common.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi parse common) 3 | (export parse-integer parse-unsigned-integer parse-c-integer 4 | parse-real parse-complex 5 | parse-identifier parse-delimited parse-separated parse-records 6 | parse-space parse-binary-op 7 | parse-ipv4-address parse-ipv6-address parse-ip-address 8 | parse-domain parse-common-domain parse-email parse-uri 9 | char-hex-digit? char-octal-digit?) 10 | (cond-expand 11 | (chibi (import (chibi))) 12 | (else (import (scheme base) (scheme char)))) 13 | (import (chibi parse)) 14 | (include "common.scm")) 15 | -------------------------------------------------------------------------------- /lib/chibi/pathname.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> A general, non-filesystem-specific pathname library. 3 | 4 | (define-library (chibi pathname) 5 | (export path-strip-directory path-directory 6 | path-extension path-strip-extension path-replace-extension 7 | path-absolute? path-relative? path-strip-leading-parents 8 | path-relative-to path-resolve path-normalize make-path) 9 | (cond-expand 10 | (chibi (import (chibi))) 11 | (else (import (except (scheme base) string-map string-for-each)))) 12 | (import (chibi string)) 13 | (include "pathname.scm")) 14 | -------------------------------------------------------------------------------- /lib/chibi/process-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi process-test) 2 | (export run-tests) 3 | (import (chibi) (chibi process) (only (chibi test) test-begin test test-end)) 4 | (begin 5 | (define (run-tests) 6 | (test-begin "processes") 7 | (test #t (process-running? (current-process-id))) 8 | (test #t (process-running? (parent-process-id))) 9 | (test #f (process-running? -1)) 10 | (test #f (signal-set-contains? (current-signal-mask) signal/alarm)) 11 | (test #t (signal-set? (make-signal-set))) 12 | (test #t (signal-set? (current-signal-mask))) 13 | (test #f (signal-set? #f)) 14 | (test #f (signal-set? '(#f))) 15 | (test #f (signal-set-contains? (make-signal-set) signal/interrupt)) 16 | (test #t (let ((sset (make-signal-set))) 17 | (signal-set-fill! sset) 18 | (signal-set-contains? sset signal/interrupt))) 19 | (test #t (let ((sset (make-signal-set))) 20 | (signal-set-add! sset signal/interrupt) 21 | (signal-set-contains? sset signal/interrupt))) 22 | (test #f (let ((sset (make-signal-set))) 23 | (signal-set-fill! sset) 24 | (signal-set-delete! sset signal/interrupt) 25 | (signal-set-contains? sset signal/interrupt))) 26 | (test-end)))) 27 | -------------------------------------------------------------------------------- /lib/chibi/process.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi process) 3 | (export exit emergency-exit sleep alarm 4 | %fork fork kill execute waitpid system system? 5 | process-command-line process-running? 6 | set-signal-action! make-signal-set 7 | signal-set? signal-set-contains? 8 | signal-set-fill! signal-set-add! signal-set-delete! 9 | current-signal-mask current-process-id parent-process-id 10 | signal-mask-block! signal-mask-unblock! signal-mask-set! 11 | signal/hang-up signal/interrupt signal/quit 12 | signal/illegal signal/abort signal/fpe 13 | signal/kill signal/segv signal/pipe 14 | signal/alarm signal/term signal/user1 15 | signal/user2 signal/child signal/continue 16 | signal/stop signal/tty-stop signal/tty-input 17 | signal/tty-output wait/no-hang 18 | call-with-process-io process->bytevector 19 | process->string process->sexp process->string-list 20 | process->output+error process->output+error+status) 21 | (import (chibi) (chibi io) (chibi string) (chibi filesystem) (only (scheme base) call/cc)) 22 | (cond-expand (threads (import (srfi 18) (srfi 151))) (else #f)) 23 | (cond-expand ((not windows) (include-shared "process"))) 24 | (include "process.scm")) 25 | -------------------------------------------------------------------------------- /lib/chibi/pty-test.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi pty-test) 3 | (import (scheme base) (scheme file) (scheme write) 4 | (chibi io) (chibi pty) (chibi stty) (chibi test)) 5 | (export run-tests) 6 | (begin 7 | (define (run-tests . o) 8 | (when (file-exists? "/usr/bin/units") 9 | (test-begin "pty") 10 | (test '("\t* 3.2808399" "\t/ 0.3048") 11 | (call-with-pty-process-io 12 | '("/usr/bin/units" "-q") 13 | (lambda (pid in out name) 14 | (with-raw-io 15 | out 16 | (lambda () 17 | ;; input with tab completion 18 | (display "mete\t" out) (newline out) 19 | (display "fee\t" out) (newline out) 20 | (display (integer->char 4) out) 21 | (flush-output-port out) 22 | ;; result 23 | (let* ((l1 (read-line in)) 24 | (l2 (read-line in))) 25 | (list l1 l2))))))) 26 | (test-end))))) 27 | -------------------------------------------------------------------------------- /lib/chibi/pty.stub: -------------------------------------------------------------------------------- 1 | 2 | (cond-expand 3 | ((or macosx openbsd netbsd) (c-system-include "util.h")) 4 | ((or freebsd dragonfly) (c-system-include "libutil.h")) 5 | (else (c-system-include "pty.h"))) 6 | (cond-expand 7 | ((not bsd) (c-system-include "utmp.h"))) 8 | 9 | (c-link "util") 10 | 11 | (declare-c-struct termios) 12 | (declare-c-struct winsize) 13 | 14 | (define-c errno openpty 15 | ((result fileno) (result fileno) (result (array char 256)) (maybe-null default NULL termios) (maybe-null default NULL winsize))) 16 | (define-c pid_t forkpty 17 | ((result fileno) (result (array char 256)) (maybe-null default NULL termios) (maybe-null default NULL winsize))) 18 | (define-c int (login-tty "login_tty") (fileno)) 19 | -------------------------------------------------------------------------------- /lib/chibi/quoted-printable-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi quoted-printable-test) 2 | (export run-tests) 3 | (import (scheme base) (chibi quoted-printable) (chibi string) (chibi test)) 4 | (begin 5 | (define (run-tests) 6 | (test-begin "quoted-printable") 7 | 8 | (test "J'interdis aux marchands de vanter trop leur marchandises. Car ils se font vite pédagogues et t'enseignent comme but ce qui n'est par essence qu'un moyen, et te trompant ainsi sur la route à suivre les voilà bientôt qui te dégradent, car si leur musique est vulgaire ils te fabriquent pour te la vendre une âme vulgaire." 9 | (quoted-printable-decode-string 10 | "J'interdis aux marchands de vanter trop leur marchandises. Car ils se font = 11 | vite p=C3=A9dagogues et t'enseignent comme but ce qui n'est par essence qu'= 12 | un moyen, et te trompant ainsi sur la route =C3=A0 suivre les voil=C3=A0 bi= 13 | ent=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire ils te f= 14 | abriquent pour te la vendre une =C3=A2me vulgaire.")) 15 | 16 | (test-end)))) 17 | -------------------------------------------------------------------------------- /lib/chibi/quoted-printable.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi quoted-printable) 3 | (export quoted-printable-encode quoted-printable-encode-string 4 | quoted-printable-encode-bytevector 5 | quoted-printable-encode-header 6 | quoted-printable-decode quoted-printable-decode-string 7 | quoted-printable-decode-bytevector) 8 | (import (scheme base)) 9 | (cond-expand 10 | ((library (srfi 151)) (import (srfi 151))) 11 | ((library (srfi 33)) (import (srfi 33))) 12 | (else (import (srfi 60)))) 13 | (cond-expand 14 | (chibi (import (chibi io))) 15 | (else 16 | (begin 17 | (define (port->string in) 18 | (let ((out (open-output-string))) 19 | (let lp () 20 | (let ((ch (read-char in))) 21 | (cond 22 | ((eof-object? ch) 23 | (get-output-string out)) 24 | (else 25 | (write-char ch out) 26 | (lp)))))))))) 27 | (include "quoted-printable.scm")) 28 | -------------------------------------------------------------------------------- /lib/chibi/regexp/pcre.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi regexp pcre) 3 | (export pcre->sre pcre->regexp) 4 | (import (scheme base) (scheme char) (scheme cxr) 5 | (srfi 1) 6 | (chibi string) (chibi regexp)) 7 | (cond-expand 8 | ((library (srfi 151)) (import (srfi 151))) 9 | ((library (srfi 33)) (import (srfi 33))) 10 | (else (import (srfi 60)))) 11 | (include "pcre.scm")) 12 | -------------------------------------------------------------------------------- /lib/chibi/reload.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi reload) 3 | (import (chibi) 4 | (meta) 5 | (srfi 39) 6 | (only (chibi time) current-seconds) 7 | (only (chibi filesystem) file-modification-time)) 8 | (include "reload.scm") 9 | (export reload reload-modified-modules reload-verbose?)) 10 | -------------------------------------------------------------------------------- /lib/chibi/repl.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi repl) 3 | (export repl repl-print repl-print-exception 4 | $0 $1 $2 $3 $4 $5 $6 $7 $8 $9) 5 | (import (chibi) (only (meta) load-module module-name->file) 6 | (chibi ast) (chibi modules) (chibi doc) (chibi generic) 7 | (chibi string) (chibi io) (chibi optional) 8 | (chibi process) (chibi term edit-line) 9 | (srfi 1) 10 | (srfi 9) 11 | (only (srfi 18) current-thread) 12 | (srfi 38) 13 | (srfi 95) 14 | (srfi 98)) 15 | (include "repl.scm")) 16 | -------------------------------------------------------------------------------- /lib/chibi/scribble.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi scribble) 3 | (export scribble-parse scribble-read) 4 | (import (scheme base) (scheme char) (scheme read)) 5 | (include "scribble.scm")) 6 | -------------------------------------------------------------------------------- /lib/chibi/shell.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi shell) 3 | (import (scheme base) (scheme bitwise) (scheme char) (scheme cxr) 4 | (scheme list) (scheme write) (srfi 130) 5 | (chibi io) (chibi filesystem) (chibi process) 6 | (only (chibi) port-fileno define-auxiliary-syntax)) 7 | (export shell shell& shell-pipe call-with-shell-io 8 | shell->string shell->string-list 9 | shell->sexp shell->sexp-list 10 | shell-if shell-and shell-or shell-do 11 | in< out> err> out>> err>> >< >> <<) 12 | (begin 13 | (define shell-fork fork) 14 | (define shell-exec execute) 15 | (define shell-exit exit) 16 | (define (shell-wait pid) 17 | (cadr (waitpid pid 0))) 18 | (define (shell-create-pipe) (apply cons (open-pipe))) 19 | (define shell-dup duplicate-file-descriptor-to) 20 | (define shell-open-input open-input-file-descriptor) 21 | (define shell-open-output open-output-file-descriptor) 22 | (define shell-close close-file-descriptor) 23 | (define (shell-port->fd port) 24 | (port-fileno port)) 25 | (define (shell-fd->input-port fd) 26 | (open-input-file-descriptor fd)) 27 | (define (shell-fd->output-port fd) 28 | (open-output-file-descriptor fd))) 29 | (include "shell.scm")) 30 | -------------------------------------------------------------------------------- /lib/chibi/show.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show) (alias-for (srfi 166))) 3 | -------------------------------------------------------------------------------- /lib/chibi/show/base.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show base) (alias-for (srfi 166 base))) 3 | -------------------------------------------------------------------------------- /lib/chibi/show/c.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show c) 3 | (export 4 | c-in-expr c-in-stmt c-in-test 5 | c-paren c-maybe-paren c-type c-literal? c-literal char->c-char 6 | c-struct c-union c-class c-enum c-typedef c-cast 7 | c-expr c-expr/sexp c-apply c-op c-indent c-indent-string 8 | c-wrap-stmt c-open-brace c-close-brace 9 | c-block c-braced-block c-begin 10 | c-fun c-var c-prototype c-param c-param-list 11 | c-while c-for c-if c-switch 12 | c-case c-case/fallthrough c-default 13 | c-break c-continue c-return c-goto c-label 14 | c-static c-const c-extern c-volatile c-auto c-restrict c-inline 15 | c++ c-- c+ c- c* c/ c% c& c^ c~ c! c&& c<< c>> c== c!= ; |c\|| |c\|\|| 16 | c< c> c<= c>= c= c+= c-= c*= c/= c%= c&= c^= c<<= c>>= ;++c --c ; |c\|=| 17 | c++/post c--/post c. c-> 18 | c-bit-or c-or c-bit-or= 19 | cpp-if cpp-ifdef cpp-ifndef cpp-elif cpp-endif cpp-undef 20 | cpp-include cpp-define cpp-wrap-header cpp-pragma cpp-line 21 | cpp-error cpp-warning cpp-stringify cpp-sym-cat 22 | c-comment c-block-comment c-attribute) 23 | (import (chibi) (chibi string) (chibi show) (chibi show pretty) 24 | (srfi 1) (scheme cxr)) 25 | (include "c.scm")) 26 | -------------------------------------------------------------------------------- /lib/chibi/show/color.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show color) (alias-for (srfi 166 color))) 3 | -------------------------------------------------------------------------------- /lib/chibi/show/column.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show column) (alias-for (srfi 166 columnar))) 3 | -------------------------------------------------------------------------------- /lib/chibi/show/pretty.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show pretty) (alias-for (srfi 166 pretty))) 3 | -------------------------------------------------------------------------------- /lib/chibi/show/unicode.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi show unicode) (alias-for (srfi 166 unicode))) 3 | -------------------------------------------------------------------------------- /lib/chibi/snow/utils.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi snow utils) 3 | (export find-in-path find-sexp-in-path 4 | write-to-string display-to-string 5 | resource->bytevector uri-normalize uri-directory 6 | version-split version-compare version>? version>=? 7 | topological-sort 8 | known-implementations impl->version impl->features) 9 | (import (scheme base) 10 | (scheme char) 11 | (scheme file) 12 | (scheme lazy) 13 | (scheme read) 14 | (scheme write) 15 | (scheme process-context) 16 | (srfi 1) 17 | (chibi config) 18 | (chibi char-set) 19 | (chibi net http) 20 | (chibi pathname) 21 | (chibi process) 22 | (chibi string) 23 | (chibi uri)) 24 | (cond-expand 25 | (chibi (import (chibi io))) 26 | (chicken 27 | (begin 28 | (define (port->bytevector in) (read-bytevector #f in)) 29 | (define (file->bytevector in) 30 | (call-with-input-file in port->bytevector)) 31 | (define (call-with-output-string proc) 32 | (let ((out (open-output-string))) 33 | (proc out) 34 | (get-output-string out)))))) 35 | (include "utils.scm")) 36 | -------------------------------------------------------------------------------- /lib/chibi/stty.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi stty) 3 | (export stty with-stty with-raw-io 4 | get-terminal-width get-terminal-dimensions 5 | TCSANOW TCSADRAIN TCSAFLUSH 6 | winsize winsize? make-winsize winsize-row winsize-col 7 | termios term-attrs? make-term-attrs 8 | ;;term-attrs-iflag term-attrs-iflag-set! 9 | ;;term-attrs-oflag term-attrs-oflag-set! 10 | ;;term-attrs-cflag term-attrs-cflag-set! 11 | ;;term-attrs-lflag term-attrs-lflag-set! 12 | ) 13 | (import (chibi) (srfi 69) (srfi 151)) 14 | (include-shared "stty") 15 | (include "stty.scm")) 16 | -------------------------------------------------------------------------------- /lib/chibi/sxml-test.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi sxml-test) 3 | (import (scheme base) (chibi sxml) (chibi test)) 4 | (export run-tests) 5 | (begin 6 | (define (run-tests) 7 | (test-begin "sxml") 8 | (test "

hello, world


" 9 | (sxml->xml '(*TOP* (html (body (div (p "hello, world") (br))))))) 10 | (test-end)))) 11 | -------------------------------------------------------------------------------- /lib/chibi/sxml.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Utilities to convert sxml to xml or plain text. 3 | 4 | (define-library (chibi sxml) 5 | (export sxml->xml sxml-display-as-html sxml-display-as-text sxml-strip 6 | html-escape html-tag->string) 7 | (import (scheme base) (scheme list) (scheme write)) 8 | (include "sxml.scm")) 9 | -------------------------------------------------------------------------------- /lib/chibi/syntax-case.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi syntax-case) 2 | (export ... _ free-identifier=? bound-identifier=? identifier? 3 | syntax-case syntax quasisyntax unsyntax unsyntax-splicing 4 | datum->syntax syntax->datum 5 | generate-temporaries with-syntax syntax-violation 6 | with-ellipsis ellipsis-identifier? 7 | define-syntax let-syntax letrec-syntax) 8 | (import (rename (chibi) 9 | (define-syntax %define-syntax) 10 | (let-syntax %let-syntax) 11 | (letrec-syntax %letrec-syntax)) 12 | (only (chibi ast) 13 | env-cell macro? macro-aux macro-aux-set! 14 | procedure-arity procedure-variadic? 15 | procedure-variable-transformer? 16 | make-variable-transformer) 17 | (only (meta) environment) 18 | (srfi 1) 19 | (srfi 2) 20 | (srfi 9) 21 | (srfi 11) 22 | (srfi 39)) 23 | (include "syntax-case.scm")) 24 | -------------------------------------------------------------------------------- /lib/chibi/system.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi system) 3 | (export get-host-name 4 | user? user-name user-password 5 | user-id user-group-id user-gecos user-home user-shell 6 | group? group-name group-password group-id 7 | current-user-id current-group-id 8 | current-effective-user-id current-effective-group-id 9 | set-current-user-id! set-current-effective-user-id! 10 | set-current-group-id! set-current-effective-group-id! 11 | current-session-id create-session 12 | set-root-directory!) 13 | (import (chibi)) 14 | (include-shared "system") 15 | (cond-expand 16 | (emscripten) 17 | (else 18 | (export user-information group-information) 19 | (body 20 | (define (safe-car x) (and (pair? x) (car x))) 21 | (define (user-information user) 22 | (safe-car (if (string? user) 23 | (getpwnam_r user (make-string 1024)) 24 | (getpwuid_r user (make-string 1024))))) 25 | (define (group-information group) 26 | (safe-car (if (string? group) 27 | (getgrnam-safe group (make-string 1024)) 28 | (getgrgid-safe group (make-string 1024))))))))) 29 | -------------------------------------------------------------------------------- /lib/chibi/tar.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi tar) 3 | (import (scheme base) (scheme file) (scheme time) (srfi 1) (scheme write) 4 | (chibi string) (chibi binary-record) (chibi pathname) 5 | (chibi filesystem)) 6 | (cond-expand 7 | ((library (srfi 151)) (import (srfi 151))) 8 | ((library (srfi 33)) (import (srfi 33))) 9 | (else (import (srfi 60)))) 10 | (cond-expand 11 | (chibi 12 | (import (chibi system))) 13 | (chicken 14 | (import posix) 15 | (begin 16 | (define (user-name x) (if (pair? x) (car x) "nobody")) 17 | (define (group-name x) (if (pair? x) (car x) "nobody"))))) 18 | (export 19 | ;; basic 20 | tar make-tar tar? read-tar write-tar 21 | ;; utilities 22 | tar-safe? tar-files tar-fold tar-extract tar-extract-file tar-create 23 | ;; accessors 24 | tar-path tar-path-prefix tar-mode tar-uid tar-gid 25 | tar-owner tar-group tar-size 26 | tar-time tar-type tar-link-name 27 | tar-path-set! tar-mode-set! tar-uid-set! tar-gid-set! 28 | tar-owner-set! tar-group-set! tar-size-set! 29 | tar-time-set! tar-type-set! tar-link-name-set! 30 | tar-device-major tar-device-major-set! 31 | tar-device-minor tar-device-minor-set! 32 | tar-ustar tar-ustar-set!) 33 | (include "tar.scm")) 34 | -------------------------------------------------------------------------------- /lib/chibi/temp-file.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi temp-file) 2 | (export call-with-temp-file call-with-temp-dir) 3 | (import (scheme base) (scheme time) 4 | (chibi filesystem) (chibi pathname)) 5 | (cond-expand 6 | ((library (srfi 151)) (import (srfi 151))) 7 | ((library (srfi 33)) (import (srfi 33))) 8 | (else (import (srfi 60)))) 9 | (cond-expand 10 | (chibi (import (only (chibi process) current-process-id))) 11 | (chicken (import (only (posix) current-process-id))) 12 | (else (begin (define (current-process-id) 0)))) 13 | (include "temp-file.scm")) 14 | -------------------------------------------------------------------------------- /lib/chibi/text.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi text) 3 | (import (scheme base) 4 | (chibi text base) 5 | (chibi text search) 6 | (chibi text types) 7 | (chibi text utf8)) 8 | (export 9 | make-text text? text-empty? 10 | text-beginning-of-line? text-end-of-line? 11 | text-char-length text-utf8-length text-piece-length 12 | string->text text->string text->utf8 13 | text-append text-append! 14 | text-concatenate text-concatenate! 15 | text-ref text-copy text-current-column 16 | text-insert! text-delete! 17 | text-mark text-mark! 18 | text-forward-char! text-backward-char! 19 | text-forward-word! text-backward-word! 20 | text-beginning-of-line? text-end-of-line? 21 | text-beginning-of-line! text-end-of-line! 22 | text-forward-line! text-backward-line! 23 | text-search! 24 | mark-text mark-offset mark-copy 25 | mark-anchor! mark-release! 26 | )) 27 | -------------------------------------------------------------------------------- /lib/chibi/text/base.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi text base) 3 | (import (scheme base) 4 | (scheme char) 5 | (scheme write) 6 | (srfi 1) 7 | (srfi 8) 8 | (chibi text types) 9 | (chibi text utf8)) 10 | (export 11 | make-text text? text-empty? 12 | text-beginning-of-line? text-end-of-line? 13 | text-char-length text-utf8-length text-piece-length 14 | string->text text->string text->utf8 15 | text-append text-append! 16 | text-concatenate text-concatenate! 17 | text-ref text-copy text-current-column 18 | text-insert! text-delete! 19 | text-mark text-mark! 20 | text-forward-char! text-backward-char! 21 | text-forward-word! text-backward-word! 22 | text-beginning-of-line? text-end-of-line? 23 | text-beginning-of-line! text-end-of-line! 24 | text-forward-line! text-backward-line! 25 | mark-text mark-offset mark-copy 26 | mark-anchor! mark-release!) 27 | (include "marks.scm") 28 | (include "base.scm") 29 | (include "movement.scm")) 30 | -------------------------------------------------------------------------------- /lib/chibi/text/search.scm: -------------------------------------------------------------------------------- 1 | 2 | ;;> Searches for the leftmost longest match for \var{rx} starting from the mark 3 | ;;> \var{mk}. If found, advances the mark. Returns the mark. 4 | (define (text-search! mk rx) 5 | (let ((rx (regexp rx)) 6 | (state (make-regexp-state))) 7 | (let lp ((tx (mark-text mk))) 8 | (and tx 9 | ;; Note string size is mis-named, it's actually the end offset. 10 | (let* ((bv (text-bytes tx)) 11 | (start (if (eqv? tx (mark-text mk)) (mark-offset mk) (text-start tx))) 12 | (end (text-end tx)) 13 | (str (utf8->string! bv start end)) 14 | (sc1 (string-cursor-start str)) 15 | (sc2 (string-cursor-end str))) 16 | (regexp-advance! #t (eq? tx (mark-text mk)) rx str sc1 sc2 state) 17 | (cond 18 | ((regexp-state-matches state) 19 | => (lambda (match) 20 | (let ((offset (string-cursor-offset (regexp-match-ref match 1)))) 21 | ;; TODO: the match could have been a previous text 22 | (mark-text-set! mk tx) 23 | (mark-offset-set! mk (+ start offset)) 24 | mk))) 25 | (else 26 | (lp (text-next tx))))))))) 27 | -------------------------------------------------------------------------------- /lib/chibi/text/search.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi text search) 3 | (import (scheme base) 4 | (chibi regexp) 5 | (chibi text base) 6 | (chibi text types) 7 | (chibi text utf8) 8 | (srfi 130)) 9 | (cond-expand 10 | (chibi 11 | (import (only (chibi) string-cursor-offset))) 12 | (else 13 | ;; assume cursors are indexes 14 | (begin 15 | (define (string-cursor-offset sc) sc)))) 16 | (export text-search!) 17 | (include "search.scm")) 18 | -------------------------------------------------------------------------------- /lib/chibi/text/types.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi text types) 3 | (import (scheme base)) 4 | (export 5 | make-text text? 6 | text-bytes text-bytes-set! 7 | text-start text-start-set! 8 | text-end text-end-set! 9 | text-prev text-prev-set! 10 | text-next text-next-set! 11 | text-marks text-marks-set! 12 | text-source text-source-set! 13 | text-first text-last 14 | make-mark mark? 15 | mark-text mark-text-set! 16 | mark-offset mark-offset-set! 17 | mark-data mark-data-set! 18 | ;; loading 19 | make-text-source text-source? 20 | text-source-loader text-source-loader-set! 21 | text-source-path text-source-path-set! 22 | text-source-data text-source-data-set! 23 | make-text-loader text-loader? 24 | text-loader-load text-loader-load-set! 25 | text-loader-reload text-loader-reload-set! 26 | text-loader-write text-loader-write-set! 27 | text-loader-modified? text-loader-modified?-set!) 28 | (include "types.scm")) 29 | -------------------------------------------------------------------------------- /lib/chibi/text/utf8.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (utf8-initial-byte-length bv offset) 3 | (let ((ch (bytevector-u8-ref bv offset))) 4 | (cond 5 | ((< ch #xC0) 1) 6 | ((< ch #xE0) 2) 7 | (else (+ 3 (bitwise-and 1 (arithmetic-shift ch -4))))))) 8 | 9 | (define (utf8-ref bv offset) 10 | (let ((end (min (+ 4 offset) (bytevector-length bv)))) 11 | ;; TODO: this is unsafe, read directly 12 | (string-ref (utf8->string! bv offset end) 0))) 13 | 14 | (define (utf8-next bv offset end) 15 | (min end (+ offset (utf8-initial-byte-length bv offset)))) 16 | 17 | (define (utf8-prev bv offset start) 18 | (let lp ((i (- offset 1))) 19 | (and (>= i start) 20 | (if (= #b10 (arithmetic-shift (bytevector-u8-ref bv i) -6)) 21 | (lp (- i 1)) 22 | i)))) 23 | -------------------------------------------------------------------------------- /lib/chibi/text/utf8.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi text utf8) 3 | (export string->utf8! utf8->string! utf8-ref utf8-next utf8-prev) 4 | (cond-expand 5 | ((and chibi (not portable)) 6 | (import (only (chibi io) 7 | string->utf8! utf8->string! utf8-ref utf8-next utf8-prev))) 8 | (else 9 | (import (scheme base) (scheme bitwise)) 10 | (include "utf8.scm") 11 | (begin 12 | (define utf8->string! utf8->string) 13 | (define string->utf8! string->utf8))))) 14 | -------------------------------------------------------------------------------- /lib/chibi/trace.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi trace) 3 | (export trace untrace untrace-all trace-cell untrace-cell) 4 | (import (chibi) (chibi ast) (srfi 38) (srfi 39) (srfi 69)) 5 | (include "trace.scm")) 6 | -------------------------------------------------------------------------------- /lib/chibi/type-inference.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi type-inference) 3 | (export type-analyze-module type-analyze procedure-signature 4 | type=? type-subset?) 5 | (import (chibi) (srfi 1) (srfi 38) (srfi 69) 6 | (chibi modules) (chibi ast) (chibi match)) 7 | (include "type-inference.scm")) 8 | 9 | -------------------------------------------------------------------------------- /lib/chibi/uri.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi uri) 3 | (export uri? uri->string make-uri string->uri string->path-uri uri-has-scheme? 4 | uri-scheme uri-user uri-host uri-port uri-path uri-query uri-fragment 5 | uri-with-scheme uri-with-user uri-with-host uri-with-path 6 | uri-with-query uri-with-fragment uri-resolve 7 | uri-encode uri-decode uri-query->alist uri-alist->query) 8 | (cond-expand 9 | (chibi 10 | (import (chibi) (srfi 9))) 11 | (else 12 | (import (except (scheme base) string-map string-for-each) 13 | (scheme char)) 14 | (begin 15 | (define (string-concatenate ls) 16 | (apply string-append ls))))) 17 | (import (chibi string) (chibi pathname)) 18 | (include "uri.scm")) 19 | -------------------------------------------------------------------------------- /lib/chibi/weak.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Library for weak data structures. 3 | 4 | ;;> \procedure{(make-ephemeron key value)} 5 | 6 | ;;> Returns a new ephemeron. This ephemeron holds a weak reference to 7 | ;;> \var{key}, such that \var{value} will only be traced by the GC if 8 | ;;> \var{key} is referenced from an external object. 9 | 10 | ;;> \procedure{(ephemeron? x)} 11 | ;;> Returns true iff \var{x} is an ephemeron. 12 | 13 | ;;> \procedure{(ephemeron-broken? ephemeron)} 14 | ;;> Returns true iff \var{ephemeron}s \var{key} has been GCed. 15 | 16 | ;;> \procedure{(ephemeron-key ephemeron)} 17 | ;;> Returns \var{ephemeron}s \var{key}, or \scheme{#f} if it has been GCed. 18 | 19 | ;;> \procedure{(ephemeron-value ephemeron)} 20 | ;;> Returns \var{ephemeron}s \var{value}. 21 | 22 | (define-library (chibi weak) 23 | (export make-ephemeron ephemeron? ephemeron-broken? 24 | ephemeron-key ephemeron-value 25 | ;; make-weak-vector weak-vector? weak-vector-length 26 | ;; weak-vector-ref weak-vector-set! 27 | ) 28 | (include-shared "weak")) 29 | -------------------------------------------------------------------------------- /lib/chibi/win32/process-win32.scm: -------------------------------------------------------------------------------- 1 | (define unwind #f) 2 | 3 | ((call/cc 4 | (lambda (k) 5 | (set! unwind k) 6 | (lambda () #f)))) 7 | 8 | (define (emergency-exit . code?) 9 | (%exit (if (pair? code?) 10 | (let ((c (car code?))) 11 | (cond ((integer? c) c) 12 | ((eq? #t c) 0) 13 | (else 1))) 14 | 0))) 15 | 16 | (define (exit . o) 17 | (unwind (lambda () (apply emergency-exit o)))) 18 | -------------------------------------------------------------------------------- /lib/chibi/win32/process-win32.sld: -------------------------------------------------------------------------------- 1 | (define-library (chibi win32 process-win32) 2 | (import (scheme base)) 3 | (export exit emergency-exit) 4 | (cond-expand 5 | (windows 6 | (include-shared "process-win32") 7 | (include "process-win32.scm")) 8 | (else 9 | (import (only (chibi process) exit emergency-exit))))) 10 | -------------------------------------------------------------------------------- /lib/chibi/win32/process-win32.stub: -------------------------------------------------------------------------------- 1 | ;;> An interface to Win32 MSVCRT provided process functions and Win32 APIs 2 | 3 | (c-system-include "stdlib.h") 4 | 5 | (define-c void (%exit exit) (int)) 6 | -------------------------------------------------------------------------------- /lib/chibi/zlib.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (chibi zlib) 3 | (export gzip-file gunzip-file gzip gunzip maybe-gunzip) 4 | (import (scheme base) 5 | (chibi temp-file)) 6 | (cond-expand 7 | (chibi (import (chibi process))) 8 | (chicken 9 | (import (rename (chicken) (system %system)) 10 | (only (data-structures) intersperse) 11 | (only (posix) process)) 12 | (begin 13 | (define (system . args) 14 | (%system (apply string-append (intersperse args " ")))) 15 | (define (process->bytevector cmd) 16 | (call-with-values (lambda () 17 | (if (pair? cmd) 18 | (process (car cmd) (cdr cmd)) 19 | (process cmd))) 20 | (lambda (in out pid) 21 | (read-bytevector #f in))))))) 22 | (include "zlib.scm")) 23 | -------------------------------------------------------------------------------- /lib/scheme/bitwise.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme bitwise) (alias-for (srfi 151))) 3 | -------------------------------------------------------------------------------- /lib/scheme/box.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme box) (alias-for (srfi 111))) 3 | -------------------------------------------------------------------------------- /lib/scheme/case-lambda.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme case-lambda) (alias-for (srfi 16))) 3 | -------------------------------------------------------------------------------- /lib/scheme/char.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme char) 3 | (import (scheme base)) 4 | (cond-expand 5 | (full-unicode 6 | (import (chibi char-set full) 7 | (chibi char-set base) 8 | (chibi iset base)) 9 | (include "char/full.scm") 10 | (include "char/special-casing.scm") 11 | (include "char/case-offsets.scm")) 12 | (else 13 | (include "char/ascii.scm") 14 | (import 15 | (only (chibi) 16 | string-ci<=? string-ci=? string-ci>? 17 | char-ci<=? char-ci=? char-ci>? 18 | char-alphabetic? char-lower-case? char-numeric? 19 | char-upper-case? char-whitespace? digit-value 20 | char-upcase char-downcase)))) 21 | (include "digit-value.scm") 22 | (export 23 | char-alphabetic? char-ci<=? char-ci=? char-ci>? 24 | char-downcase char-foldcase char-lower-case? char-numeric? 25 | char-upcase char-upper-case? char-whitespace? digit-value 26 | string-ci<=? string-ci=? string-ci>? 27 | char-get-special-case 28 | string-downcase string-foldcase string-upcase)) 29 | -------------------------------------------------------------------------------- /lib/scheme/char/ascii.scm: -------------------------------------------------------------------------------- 1 | 2 | (define char-foldcase char-downcase) 3 | 4 | (define (string-downcase str) 5 | (string-map char-downcase str)) 6 | 7 | (define (string-upcase str) 8 | (string-map char-upcase str)) 9 | 10 | (define (string-foldcase str) 11 | (string-map char-foldcase str)) 12 | -------------------------------------------------------------------------------- /lib/scheme/char/normalization.sld: -------------------------------------------------------------------------------- 1 | ;; This library is deprecated, occurring in early R7RS drafts before 2 | ;; being removed. 3 | 4 | (define-library (scheme char normalization) 5 | (import (rename (chibi) 6 | (string=? string-ni=?) 7 | (string? string-ni>?) 9 | (string<=? string-ni<=?) 10 | (string>=? string-ni>=?))) 11 | (export string-ni=? string-ni? string-ni<=? string-ni>=?)) 12 | -------------------------------------------------------------------------------- /lib/scheme/charset.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme charset) (alias-for (srfi 14))) 3 | -------------------------------------------------------------------------------- /lib/scheme/comparator.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme comparator) (alias-for (srfi 128))) 3 | -------------------------------------------------------------------------------- /lib/scheme/complex.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme complex) 3 | (import (chibi)) 4 | (export angle imag-part magnitude make-polar make-rectangular real-part)) 5 | -------------------------------------------------------------------------------- /lib/scheme/cxr.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; provide c[ad]{3,4}r 3 | 4 | (define (caaar x) (car (car (car x)))) 5 | (define (caadr x) (car (car (cdr x)))) 6 | (define (cadar x) (car (cdr (car x)))) 7 | (define (caddr x) (car (cdr (cdr x)))) 8 | (define (cdaar x) (cdr (car (car x)))) 9 | (define (cdadr x) (cdr (car (cdr x)))) 10 | (define (cddar x) (cdr (cdr (car x)))) 11 | (define (cdddr x) (cdr (cdr (cdr x)))) 12 | (define (caaaar x) (car (car (car (car x))))) 13 | (define (caaadr x) (car (car (car (cdr x))))) 14 | (define (caadar x) (car (car (cdr (car x))))) 15 | (define (caaddr x) (car (car (cdr (cdr x))))) 16 | (define (cadaar x) (car (cdr (car (car x))))) 17 | (define (cadadr x) (car (cdr (car (cdr x))))) 18 | (define (caddar x) (car (cdr (cdr (car x))))) 19 | (define (cadddr x) (car (cdr (cdr (cdr x))))) 20 | (define (cdaaar x) (cdr (car (car (car x))))) 21 | (define (cdaadr x) (cdr (car (car (cdr x))))) 22 | (define (cdadar x) (cdr (car (cdr (car x))))) 23 | (define (cdaddr x) (cdr (car (cdr (cdr x))))) 24 | (define (cddaar x) (cdr (cdr (car (car x))))) 25 | (define (cddadr x) (cdr (cdr (car (cdr x))))) 26 | (define (cdddar x) (cdr (cdr (cdr (car x))))) 27 | (define (cddddr x) (cdr (cdr (cdr (cdr x))))) 28 | -------------------------------------------------------------------------------- /lib/scheme/cxr.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme cxr) 3 | (import (chibi)) 4 | (export 5 | caaar caadr cadar caddr cdaar cdadr cddar cdddr 6 | caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr 7 | cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr) 8 | (include "cxr.scm")) 9 | -------------------------------------------------------------------------------- /lib/scheme/define-values.scm: -------------------------------------------------------------------------------- 1 | 2 | (define-syntax define-values 3 | (syntax-rules () 4 | ((define-values () expr) 5 | (define dummy 6 | (call-with-values (lambda () expr) 7 | (lambda args #f)))) 8 | ((define-values (var) expr) 9 | (define var expr)) 10 | ((define-values (var0 var1 ... varn) expr) 11 | (begin 12 | (define var0 13 | (call-with-values (lambda () expr) list)) 14 | (define var1 15 | (let ((v (cadr var0))) 16 | (set-cdr! var0 (cddr var0)) 17 | v)) 18 | ... 19 | (define varn 20 | (let ((v (cadr var0))) 21 | (set! var0 (car var0)) 22 | v)))) 23 | ((define-values (var0 var1 ... . var-dot) expr) 24 | (begin 25 | (define var0 26 | (call-with-values (lambda () expr) list)) 27 | (define var1 28 | (let ((v (cadr var0))) 29 | (set-cdr! var0 (cddr var0)) 30 | v)) 31 | ... 32 | (define var-dot 33 | (let ((v (cdr var0))) 34 | (set! var0 (car var0)) 35 | v)))) 36 | ((define-values var expr) 37 | (define var 38 | (call-with-values (lambda () expr) list))))) 39 | -------------------------------------------------------------------------------- /lib/scheme/division.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme division) 3 | (import (scheme base)) 4 | (export ceiling-quotient ceiling-remainder ceiling/ 5 | euclidean-quotient euclidean-remainder euclidean/ 6 | round-quotient round-remainder round/ 7 | balanced-quotient balanced-remainder balanced/) 8 | ;; The second definition is always valid, but the first is simpler 9 | ;; and faster if exact ratios are supported and handled correctly 10 | ;; but floor/ceil/round. 11 | (cond-expand 12 | (ratios 13 | (begin 14 | (define-syntax copy-exactness2 15 | (syntax-rules () 16 | ((copy-exactness2 src1 src2 expr) 17 | expr))))) 18 | (else 19 | (begin 20 | (define-syntax copy-exactness2 21 | (syntax-rules () 22 | ((copy-exactness2 src1 src2 expr) 23 | (let ((tmp expr)) 24 | (if (and (exact? src1) (exact? src2)) 25 | (inexact->exact tmp) 26 | tmp)))))))) 27 | (include "division.scm")) 28 | -------------------------------------------------------------------------------- /lib/scheme/ephemeron.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme ephemeron) (alias-for (srfi 124))) 3 | -------------------------------------------------------------------------------- /lib/scheme/eval.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme eval) 3 | (import (chibi) (meta)) ; (chibi compiler analyze) 4 | (export eval environment)) 5 | -------------------------------------------------------------------------------- /lib/scheme/file.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme file) 3 | (import (chibi) (only (chibi filesystem) delete-file file-exists?)) 4 | (export 5 | call-with-input-file call-with-output-file 6 | delete-file file-exists? 7 | open-binary-input-file open-binary-output-file 8 | open-input-file open-output-file 9 | with-input-from-file with-output-to-file)) 10 | -------------------------------------------------------------------------------- /lib/scheme/fixnum.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme fixnum) (alias-for (srfi 143))) 3 | -------------------------------------------------------------------------------- /lib/scheme/flonum.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme flonum) (alias-for (srfi 144))) 3 | -------------------------------------------------------------------------------- /lib/scheme/generator.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme generator) (alias-for (srfi 121))) 3 | -------------------------------------------------------------------------------- /lib/scheme/hash-table.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme hash-table) (alias-for (srfi 125))) 3 | -------------------------------------------------------------------------------- /lib/scheme/ideque.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme ideque) (alias-for (srfi 134))) 3 | -------------------------------------------------------------------------------- /lib/scheme/ilist.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme ilist) (alias-for (srfi 116))) 3 | -------------------------------------------------------------------------------- /lib/scheme/inexact.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (nan? x) 3 | (and (real? x) (not (= x x)))) 4 | 5 | (define (finite? x) 6 | (if (real? x) 7 | (and (not (nan? x)) (not (= x +inf.0)) (not (= x -inf.0))) 8 | (and (complex? x) (finite? (real-part x)) (finite? (imag-part x))))) 9 | 10 | (define (infinite? x) 11 | (and (number? x) (not (finite? x)) (not (nan? x)))) 12 | -------------------------------------------------------------------------------- /lib/scheme/inexact.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme inexact) 3 | (import (chibi)) 4 | (export acos asin atan cos exp finite? infinite? log nan? sin sqrt tan) 5 | (include "inexact.scm")) 6 | -------------------------------------------------------------------------------- /lib/scheme/lazy.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme lazy) 3 | (import (chibi)) 4 | (export delay force delay-force make-promise promise?) 5 | (begin 6 | (define (make-promise x) 7 | (if (promise? x) x (delay x))))) 8 | -------------------------------------------------------------------------------- /lib/scheme/list-queue.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme list-queue) (alias-for (srfi 117))) 3 | -------------------------------------------------------------------------------- /lib/scheme/list.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme list) (alias-for (srfi 1))) 3 | -------------------------------------------------------------------------------- /lib/scheme/load.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme load) 3 | (import (chibi)) 4 | (export load)) 5 | -------------------------------------------------------------------------------- /lib/scheme/lseq.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme lseq) (alias-for (srfi 127))) 3 | -------------------------------------------------------------------------------- /lib/scheme/mapping.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme mapping) (alias-for (srfi 146))) 3 | -------------------------------------------------------------------------------- /lib/scheme/mapping/hash.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme mapping hash) (alias-for (srfi 146 hash))) 3 | -------------------------------------------------------------------------------- /lib/scheme/process-context.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme process-context) 3 | (import (chibi) (srfi 98)) 4 | (cond-expand (windows (import (only (chibi win32 process-win32) exit emergency-exit))) 5 | (else (import (only (chibi process) exit emergency-exit)))) 6 | (export get-environment-variable get-environment-variables 7 | command-line exit emergency-exit)) 8 | -------------------------------------------------------------------------------- /lib/scheme/read.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme read) 3 | (import (rename (srfi 38) (read/ss read))) 4 | (export read)) 5 | -------------------------------------------------------------------------------- /lib/scheme/regex.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme regex) (alias-for (srfi 115))) 3 | -------------------------------------------------------------------------------- /lib/scheme/repl.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme repl) 3 | (import (chibi)) 4 | (export interaction-environment)) 5 | -------------------------------------------------------------------------------- /lib/scheme/set.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme set) (alias-for (srfi 113))) 3 | -------------------------------------------------------------------------------- /lib/scheme/show.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme show) (alias-for (srfi 166))) 3 | -------------------------------------------------------------------------------- /lib/scheme/sort.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme sort) (alias-for (srfi 132))) 3 | -------------------------------------------------------------------------------- /lib/scheme/stream.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme stream) (alias-for (srfi 41))) 3 | -------------------------------------------------------------------------------- /lib/scheme/text.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme text) (alias-for (srfi 135))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector) (alias-for (srfi 133))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/base.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector base) (alias-for (srfi 160 base))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/c128.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector c128) (alias-for (srfi 160 c128))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/c64.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector c64) (alias-for (srfi 160 c64))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/f32.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector f32) (alias-for (srfi 160 f32))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/f64.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector f64) (alias-for (srfi 160 f64))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/s16.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector s16) (alias-for (srfi 160 s16))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/s32.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector s32) (alias-for (srfi 160 s32))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/s64.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector s64) (alias-for (srfi 160 s64))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/s8.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector s8) (alias-for (srfi 160 s8))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/u16.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector u16) (alias-for (srfi 160 u16))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/u32.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector u32) (alias-for (srfi 160 u32))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/u64.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector u64) (alias-for (srfi 160 u64))) 3 | -------------------------------------------------------------------------------- /lib/scheme/vector/u8.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme vector u8) (alias-for (srfi 160 u8))) 3 | -------------------------------------------------------------------------------- /lib/scheme/write.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (scheme write) 3 | (import (rename (chibi) (write write-simple) (display display-simple)) 4 | (rename (srfi 38) (write/ss write-shared))) 5 | (export display write write-shared write-simple) 6 | (begin 7 | (define (display x . o) 8 | (apply (if (or (string? x) (char? x)) display-simple write) x o)) 9 | (define (write x . o) 10 | (write-shared x (if (pair? o) (car o) (current-output-port)) #t)))) 11 | -------------------------------------------------------------------------------- /lib/srfi/1/alists.scm: -------------------------------------------------------------------------------- 1 | ;; alist.scm -- association list utilities 2 | ;; Copyright (c) 2009 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (alist-cons key value ls) (cons (cons key value) ls)) 6 | 7 | (define (alist-copy ls) (map (lambda (x) (cons (car x) (cdr x))) ls)) 8 | 9 | (define (alist-delete key ls . o) 10 | (let ((eq (if (pair? o) (car o) equal?))) 11 | (remove (lambda (x) (eq key (car x))) ls))) 12 | 13 | (define alist-delete! alist-delete) 14 | 15 | -------------------------------------------------------------------------------- /lib/srfi/1/constructors.scm: -------------------------------------------------------------------------------- 1 | ;; constructors.scm -- list construction utilities 2 | ;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (xcons a b) (cons b a)) 6 | 7 | (define (cons* x . args) 8 | (let lp ((rev '()) (x x) (ls args)) 9 | (if (null? ls) 10 | (append-reverse rev x) 11 | (lp (cons x rev) (car ls) (cdr ls))))) 12 | 13 | (define (list-tabulate n proc) 14 | (let lp ((n (- n 1)) (res '())) 15 | (if (< n 0) res (lp (- n 1) (cons (proc n) res))))) 16 | 17 | (define (circular-list x . args) 18 | (let ((res (cons x args))) 19 | (set-cdr! (last-pair res) res) 20 | res)) 21 | 22 | (define (iota count . o) 23 | (let ((start (if (pair? o) (car o) 0)) 24 | (step (if (and (pair? o) (pair? (cdr o))) (cadr o) 1))) 25 | (let lp ((i count) (res '())) 26 | (if (<= i 0) 27 | res 28 | (lp (- i 1) (cons (+ start (* (- i 1) step)) res)))))) 29 | -------------------------------------------------------------------------------- /lib/srfi/1/deletion.scm: -------------------------------------------------------------------------------- 1 | ;; deletion.scm -- list deletion utilities 2 | ;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (delete x ls . o) 6 | (let ((eq (if (pair? o) (car o) equal?))) 7 | (if (eq? eq eq?) 8 | (let lp ((ls ls) (rev '())) ;; fast path for delq 9 | (let ((tail (memq x ls))) 10 | (if tail 11 | (lp (cdr tail) (take-up-to-reverse ls tail rev)) 12 | (if (pair? rev) (append-reverse! rev ls) ls)))) 13 | (remove (lambda (y) (eq x y)) ls)))) 14 | 15 | (define delete! delete) 16 | 17 | (define (delete-duplicates ls . o) 18 | (let ((eq (if (pair? o) (car o) equal?))) 19 | (let lp ((ls ls) (res '())) 20 | (if (pair? ls) 21 | (lp (cdr ls) (if (member (car ls) res eq) res (cons (car ls) res))) 22 | (reverse! res))))) 23 | 24 | (define delete-duplicates! delete-duplicates) 25 | -------------------------------------------------------------------------------- /lib/srfi/1/search.scm: -------------------------------------------------------------------------------- 1 | ;; search.scm -- list searching and splitting 2 | ;; Copyright (c) 2009-2011 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (take-while pred ls) 6 | (let lp ((ls ls) (res '())) 7 | (if (and (pair? ls) (pred (car ls))) 8 | (lp (cdr ls) (cons (car ls) res)) 9 | (reverse! res)))) 10 | 11 | (define take-while! take-while) 12 | 13 | (define (drop-while pred ls) 14 | (or (find-tail (lambda (x) (not (pred x))) ls) '())) 15 | 16 | (define (span pred ls) 17 | (let lp ((ls ls) (res '())) 18 | (if (and (pair? ls) (pred (car ls))) 19 | (lp (cdr ls) (cons (car ls) res)) 20 | (values (reverse! res) ls)))) 21 | 22 | (define span! span) 23 | 24 | (define (break pred ls) (span (lambda (x) (not (pred x))) ls)) 25 | 26 | (define break! break) 27 | 28 | (define (list-index pred ls . lists) 29 | (if (null? lists) 30 | (let lp ((ls ls) (n 0)) 31 | (and (pair? ls) (if (pred (car ls)) n (lp (cdr ls) (+ n 1))))) 32 | (let lp ((lists (cons ls lists)) (n 0)) 33 | (and (every pair? lists) 34 | (if (apply pred (map car lists)) n (lp (map cdr lists) (+ n 1))) 35 | )))) 36 | -------------------------------------------------------------------------------- /lib/srfi/111.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 111) 2 | (import (scheme base)) 3 | (export box box? unbox set-box!) 4 | (begin 5 | (define-record-type Box 6 | (box value) 7 | box? 8 | (value unbox set-box!)))) 9 | -------------------------------------------------------------------------------- /lib/srfi/115.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 115) 2 | (export regexp regexp? valid-sre? rx regexp->sre char-set->sre 3 | regexp-matches regexp-matches? regexp-search 4 | regexp-replace regexp-replace-all regexp-match->list 5 | regexp-fold regexp-extract regexp-split regexp-partition 6 | regexp-match? regexp-match-count 7 | regexp-match-submatch 8 | regexp-match-submatch-start regexp-match-submatch-end) 9 | (cond-expand (chicken (import (scheme base))) (else)) 10 | (import (chibi regexp))) 11 | -------------------------------------------------------------------------------- /lib/srfi/117.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 117) 2 | (import (scheme base) (srfi 1)) 3 | (export 4 | make-list-queue list-queue list-queue-copy list-queue-unfold 5 | list-queue-unfold-right list-queue? list-queue-empty? 6 | list-queue-front list-queue-back list-queue-list list-queue-first-last 7 | list-queue-add-front! list-queue-add-back! list-queue-remove-front! 8 | list-queue-remove-back! list-queue-remove-all! list-queue-set-list! 9 | list-queue-append list-queue-append! list-queue-concatenate 10 | list-queue-map list-queue-map! list-queue-for-each) 11 | (include "117/queue.scm")) 12 | -------------------------------------------------------------------------------- /lib/srfi/121.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 121) 2 | (export generator 3 | make-iota-generator 4 | make-range-generator 5 | make-coroutine-generator 6 | list->generator 7 | vector->generator 8 | reverse-vector->generator 9 | string->generator 10 | bytevector->generator 11 | make-for-each-generator 12 | make-unfold-generator 13 | gcons* 14 | gappend 15 | gcombine 16 | gfilter 17 | gremove 18 | gtake 19 | gdrop 20 | gtake-while 21 | gdrop-while 22 | gdelete 23 | gdelete-neighbor-dups 24 | gindex 25 | gselect 26 | generator->list 27 | generator->reverse-list 28 | generator->vector 29 | generator->vector! 30 | generator->string 31 | generator-fold 32 | generator-for-each 33 | generator-find 34 | generator-count 35 | generator-any 36 | generator-every 37 | generator-unfold) 38 | (import (scheme base) (srfi 130)) 39 | (include "121/generators.scm")) 40 | -------------------------------------------------------------------------------- /lib/srfi/124.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 124) 2 | (export make-ephemeron ephemeron? ephemeron-broken? 3 | ephemeron-key ephemeron-datum reference-barrier) 4 | (import (rename (chibi weak) (ephemeron-value ephemeron-datum)) 5 | (only (scheme base) define if)) 6 | (begin 7 | (define (reference-barrier k) (if #f #f)))) 8 | -------------------------------------------------------------------------------- /lib/srfi/127.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 127) 3 | (import (scheme base) (srfi 1)) 4 | (export 5 | ;; Constructors 6 | generator->lseq 7 | ;; Predicates 8 | lseq? lseq=? 9 | ;; Selectors 10 | lseq-car lseq-cdr 11 | lseq-first lseq-rest lseq-ref 12 | lseq-take lseq-drop 13 | ;; The whole lazy sequence 14 | lseq-realize lseq->generator 15 | lseq-length 16 | lseq-append lseq-zip 17 | ;; Mapping and filtering 18 | lseq-map lseq-for-each 19 | lseq-filter lseq-remove 20 | ;; Searching 21 | lseq-find lseq-find-tail 22 | lseq-any lseq-every 23 | lseq-index 24 | lseq-take-while lseq-drop-while 25 | lseq-member lseq-memq lseq-memv) 26 | (include "127.scm")) 27 | -------------------------------------------------------------------------------- /lib/srfi/129.sld: -------------------------------------------------------------------------------- 1 | 2 | ;; Adaptation of John Cowan's reference impl for chibi, using the 3 | ;; our own char-set:title-case. 4 | 5 | (define-library (srfi 129) 6 | (import (scheme base) (scheme char) 7 | (srfi 1) 8 | (chibi char-set) (chibi char-set full) (chibi string)) 9 | (export char-title-case? char-titlecase string-titlecase) 10 | (include "129/titlemaps.scm" "129/titlecase.scm")) 11 | -------------------------------------------------------------------------------- /lib/srfi/132.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 132) 2 | (import (scheme base) (srfi 95)) 3 | (export 4 | list-sorted? vector-sorted? 5 | list-sort list-stable-sort 6 | list-sort! list-stable-sort! 7 | vector-sort vector-stable-sort 8 | vector-sort! vector-stable-sort! 9 | list-merge list-merge! 10 | vector-merge vector-merge! 11 | list-delete-neighbor-dups 12 | list-delete-neighbor-dups! 13 | vector-delete-neighbor-dups 14 | vector-delete-neighbor-dups! 15 | vector-find-median 16 | vector-find-median! 17 | vector-select! 18 | vector-separate!) 19 | (include "132/sort.scm")) 20 | -------------------------------------------------------------------------------- /lib/srfi/133.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 133) 2 | (import (scheme base)) 3 | (export 4 | ;; Constructors 5 | make-vector vector 6 | vector-unfold vector-unfold-right 7 | vector-copy vector-reverse-copy 8 | vector-append vector-concatenate vector-append-subvectors 9 | ;; Predicates 10 | vector? 11 | vector-empty? 12 | vector= 13 | ;; Selectors 14 | vector-ref 15 | vector-length 16 | ;; Iteration 17 | vector-fold vector-fold-right 18 | vector-map vector-map! 19 | vector-for-each vector-count 20 | vector-cumulate 21 | ;; Searching 22 | vector-index vector-index-right 23 | vector-skip vector-skip-right 24 | vector-binary-search 25 | vector-any vector-every 26 | vector-partition 27 | ;; Mutators 28 | vector-set! vector-swap! 29 | vector-fill! vector-reverse! 30 | vector-copy! vector-reverse-copy! 31 | vector-unfold! vector-unfold-right! 32 | ;; Conversion 33 | vector->list reverse-vector->list 34 | list->vector reverse-list->vector 35 | vector->string string->vector) 36 | (include "133/vector.scm")) 37 | -------------------------------------------------------------------------------- /lib/srfi/134.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 134) 2 | (import (scheme base) (scheme case-lambda) 3 | (srfi 1) (srfi 9) (srfi 121)) 4 | (export ideque ideque-tabulate ideque-unfold ideque-unfold-right 5 | ideque? ideque-empty? ideque= ideque-any ideque-every 6 | 7 | ideque-front ideque-add-front ideque-remove-front 8 | ideque-back ideque-add-back ideque-remove-back 9 | 10 | ideque-ref 11 | ideque-take ideque-take-right ideque-drop ideque-drop-right 12 | ideque-split-at 13 | 14 | ideque-length ideque-append ideque-reverse 15 | ideque-count ideque-zip 16 | 17 | ideque-map ideque-filter-map 18 | ideque-for-each ideque-for-each-right 19 | ideque-fold ideque-fold-right 20 | ideque-append-map 21 | 22 | ideque-filter ideque-remove ideque-partition 23 | 24 | ideque-find ideque-find-right 25 | ideque-take-while ideque-take-while-right 26 | ideque-drop-while ideque-drop-while-right 27 | ideque-span ideque-break 28 | 29 | list->ideque ideque->list 30 | generator->ideque ideque->generator 31 | ) 32 | (include "134.scm")) 33 | -------------------------------------------------------------------------------- /lib/srfi/139.scm: -------------------------------------------------------------------------------- 1 | (define-syntax out 2 | (er-macro-transformer 3 | (lambda (expr rename compare) 4 | (for-each set-cdr! (car (cddr expr)) (cadr (cddr expr))) 5 | (car (cdr expr))))) 6 | 7 | (define-syntax syntax-parameterize 8 | (lambda (expr use-env mac-env) 9 | (let* ((_let (make-syntactic-closure mac-env '() 'let)) 10 | (_set! (make-syntactic-closure mac-env '() 'set!)) 11 | (_out (make-syntactic-closure mac-env '() 'out)) 12 | (_tmp (make-syntactic-closure mac-env '() 'tmp)) 13 | (bindings (cadr expr)) 14 | (body (cddr expr)) 15 | (keywords (map car bindings)) 16 | (transformers (map cadr bindings)) 17 | (cells 18 | (map (lambda (keyword) 19 | (env-cell use-env keyword)) 20 | keywords)) 21 | (old (map cdr cells)) 22 | (new (map (lambda (transformer) 23 | (make-macro 24 | (eval 25 | (make-syntactic-closure use-env '() transformer)) 26 | use-env)) 27 | transformers))) 28 | (for-each set-cdr! cells new) 29 | `(,_let ((,_tmp #f)) 30 | (,_set! ,_tmp (,_let () ,@body)) 31 | (,_out ,_tmp ,cells ,old))))) 32 | -------------------------------------------------------------------------------- /lib/srfi/139.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 139) 2 | (export (rename define-syntax define-syntax-parameter) 3 | syntax-parameterize) 4 | (import (chibi) 5 | (chibi ast)) 6 | (include "139.scm")) 7 | -------------------------------------------------------------------------------- /lib/srfi/141.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 141) 2 | (import (scheme base) (scheme division)) 3 | (export ceiling-quotient ceiling-remainder ceiling/ 4 | euclidean-quotient euclidean-remainder euclidean/ 5 | floor-quotient floor-remainder floor/ 6 | round-quotient round-remainder round/ 7 | truncate-quotient truncate-remainder truncate/ 8 | balanced-quotient balanced-remainder balanced/)) 9 | -------------------------------------------------------------------------------- /lib/srfi/142.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 142) 3 | (export bitwise-not 4 | bitwise-and bitwise-ior 5 | bitwise-xor bitwise-eqv 6 | bitwise-nand bitwise-nor 7 | bitwise-andc1 bitwise-andc2 8 | bitwise-orc1 bitwise-orc2 9 | arithmetic-shift bit-count integer-length 10 | bitwise-if 11 | bit-set? any-bit-set? every-bit-set? 12 | first-set-bit 13 | bit-field bit-field-any? bit-field-every? 14 | bit-field-clear bit-field-set 15 | bit-field-replace bit-field-replace-same 16 | bit-field-rotate bit-field-reverse 17 | copy-bit integer->list list->integer 18 | integer->vector vector->integer 19 | bits bit-swap 20 | bitwise-fold bitwise-for-each bitwise-unfold 21 | make-bitwise-generator) 22 | (import (chibi) 23 | (rename (srfi 151) 24 | (bitwise-if srfi-151:bitwise-if) 25 | (bits->list integer->list) 26 | (list->bits list->integer) 27 | (bits->vector integer->vector) 28 | (vector->bits vector->integer))) 29 | (begin 30 | (define (bitwise-if mask n m) 31 | (srfi-151:bitwise-if mask m n)))) 32 | -------------------------------------------------------------------------------- /lib/srfi/144/flonum.scm: -------------------------------------------------------------------------------- 1 | 2 | (define fl=? =) 3 | (define fl? >) 5 | (define fl<=? <=) 6 | (define fl>=? >=) 7 | (define flodd? odd?) 8 | (define fleven? even?) 9 | (define (flunordered? x y) (or (flnan? x) (flnan? y))) 10 | (define flinteger? integer?) 11 | (define flzero? zero?) 12 | (define flpositive? positive?) 13 | (define flnegative? negative?) 14 | (define flonum exact->inexact) 15 | 16 | (define fl+ +) 17 | (define fl- -) 18 | (define fl* *) 19 | (define fl/ /) 20 | (define (flmax . args) (if (null? args) -inf.0 (apply max args))) 21 | (define (flmin . args) (if (null? args) +inf.0 (apply min args))) 22 | (define (flabsdiff x y) (abs (- x y))) 23 | (define flnumerator numerator) 24 | (define fldenominator denominator) 25 | (define flround round) 26 | 27 | (define (flsquare x) (fl* x x)) 28 | 29 | (define (flsgn x) (flcopysign 1.0 x)) 30 | 31 | (define (fldenormalized? x) 32 | (eqv? FP_SUBNORMAL (fpclassify x))) 33 | 34 | (define (flatan x . o) 35 | (if (pair? o) 36 | (flatan2 x (car o)) 37 | (flatan1 x))) 38 | 39 | (define (flinteger-fraction x) 40 | (let ((ls (modf x))) (values (cadr ls) (car ls)))) 41 | 42 | (define (flnormalized-fraction-exponent x) 43 | (apply values (frexp x))) 44 | 45 | (define (flremquo x y) 46 | (apply values (remquo x y))) 47 | 48 | (define (flloggamma x) 49 | (apply values (lgamma_r x))) 50 | -------------------------------------------------------------------------------- /lib/srfi/145.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 145) 2 | (export assume) 3 | (import (scheme base) (chibi assert)) 4 | (cond-expand 5 | ((or elide-assumptions 6 | (and (not assumptions) 7 | (not debug))) 8 | (begin 9 | (define-syntax assume 10 | (syntax-rules () 11 | ((assume expression objs ...) 12 | expression) 13 | ((assume) 14 | (syntax-error "assume requires an expression")))))) 15 | (else 16 | (begin 17 | (define-syntax assume 18 | (syntax-rules () 19 | ((assume expression objs ...) 20 | (assert expression objs ...)) 21 | ((assume) 22 | (syntax-error "assume requires an expression")))))))) 23 | -------------------------------------------------------------------------------- /lib/srfi/146/hamt-map-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 hamt-map-test) 2 | (import 3 | (scheme base) 4 | (chibi test) 5 | (srfi 146 hamt) 6 | (srfu 146 hamt-map) 7 | (srfi 146 hamt-misc) 8 | (only (srfi 1) alist-delete fold) 9 | (only (srfi 27) random-integer) 10 | (only (srfi 113) 11 | set 12 | set-adjoin! 13 | set-delete! 14 | set-for-each) 15 | (only (srfi 125) 16 | hash-table->alist 17 | hash-table-keys 18 | hash-table-delete! 19 | hash-table-for-each 20 | hash-table-set! 21 | hash-table-size 22 | string-hash) 23 | (only (srfi 128) make-comparator) 24 | (only (srfi 132) list-sort) 25 | (only (srfi 151) bit-count)) 26 | (export run-hamt-map-tests) 27 | (include "hamt-map-test.scm")) 28 | -------------------------------------------------------------------------------- /lib/srfi/146/hamt-map.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 hamt-map) 2 | (import 3 | (scheme base) 4 | (scheme case-lambda) 5 | (only (srfi 1) fold) 6 | (srfi 16) 7 | (srfi 146 hamt) 8 | (srfi 146 hamt-misc)) 9 | (export 10 | make-phm phm? 11 | phm->alist 12 | phm/add-alist phm/add-alist! 13 | phm/contains? 14 | phm/count 15 | phm/empty? 16 | phm/for-each 17 | phm/get 18 | phm/immutable 19 | phm/keys 20 | phm/mutable phm/mutable? 21 | phm/put 22 | phm/put! 23 | phm/remove phm/remove! 24 | phm/replace phm/replace! 25 | 26 | ;; This is only needed by tests: 27 | phm/data) 28 | (include "hamt-map.scm")) 29 | -------------------------------------------------------------------------------- /lib/srfi/146/hamt-misc-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 hamt-misc-test) 2 | (import (scheme base) (chibi test) (srfi 146 hamt-misc)) 3 | (export run-hamt-misc-tests) 4 | (include "hamt-misc-test.scm")) 5 | -------------------------------------------------------------------------------- /lib/srfi/146/hamt-misc.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 hamt-misc) 2 | (import 3 | (scheme base) 4 | (scheme case-lambda) 5 | (only (srfi 125) make-hash-table string-hash) 6 | (only (srfi 128) make-comparator)) 7 | (export assert do-list 8 | make-string-hash-table 9 | with-output-to-string) 10 | (include "hamt-misc.scm")) 11 | -------------------------------------------------------------------------------- /lib/srfi/146/hamt-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 hamt-test) 2 | (import (scheme base) 3 | (chibi test) 4 | (only (srfi 146 hamt) fragment->mask)) 5 | (export run-hamt-core-tests) 6 | (include "hamt-test.scm")) 7 | -------------------------------------------------------------------------------- /lib/srfi/146/hamt.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 hamt) 2 | (import (scheme base) 3 | (scheme case-lambda) 4 | (only (srfi 1) find-tail) 5 | (srfi 16) 6 | (only (srfi 143) fx-width) 7 | (srfi 151) 8 | (srfi 146 hamt-misc) 9 | (srfi 146 vector-edit)) 10 | (export fragment->mask 11 | hamt->list 12 | hamt-fetch 13 | hamt-null 14 | hamt-null? 15 | hamt/count 16 | hamt/empty? 17 | hamt/for-each 18 | hamt/immutable 19 | hamt/mutable 20 | hamt/mutable? 21 | hamt/payload? 22 | hamt/put 23 | hamt/put! 24 | hamt/replace 25 | hamt/replace! 26 | hash-array-mapped-trie? 27 | make-hamt 28 | 29 | ;; These are only needed by tests: 30 | collision? 31 | hamt-bucket-size 32 | hamt-hash-size 33 | hamt/root 34 | leaf-stride 35 | narrow/array 36 | narrow/leaves 37 | narrow? 38 | next-set-bit 39 | wide/array 40 | wide/children 41 | wide?) 42 | (include "hamt.scm")) 43 | -------------------------------------------------------------------------------- /lib/srfi/146/vector-edit-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 vector-edit-test) 2 | (import (scheme base) (chibi test) (srfi 146 vector-edit)) 3 | (export run-vector-edit-tests) 4 | (include "vector-edit-test.scm")) 5 | -------------------------------------------------------------------------------- /lib/srfi/146/vector-edit.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 146 vector-edit) 2 | (import (scheme base)) 3 | (export vector-edit vector-replace-one vector-without) 4 | (include "vector-edit.scm")) 5 | -------------------------------------------------------------------------------- /lib/srfi/147.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 147) 2 | (export define-syntax let-syntax letrec-syntax syntax-rules) 3 | (import (scheme base))) 4 | -------------------------------------------------------------------------------- /lib/srfi/151.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 151) 3 | (export bitwise-not 4 | bitwise-and bitwise-ior 5 | bitwise-xor bitwise-eqv 6 | bitwise-nand bitwise-nor 7 | bitwise-andc1 bitwise-andc2 8 | bitwise-orc1 bitwise-orc2 9 | arithmetic-shift bit-count integer-length 10 | bitwise-if 11 | bit-set? any-bit-set? every-bit-set? 12 | first-set-bit 13 | bit-field bit-field-any? bit-field-every? 14 | bit-field-clear bit-field-set 15 | bit-field-replace bit-field-replace-same 16 | bit-field-rotate bit-field-reverse 17 | copy-bit bits->list list->bits 18 | bits->vector vector->bits 19 | bits bit-swap 20 | bitwise-fold bitwise-for-each bitwise-unfold 21 | make-bitwise-generator) 22 | (import (chibi)) 23 | (include-shared "151/bit") 24 | (include "151/bitwise.scm")) 25 | -------------------------------------------------------------------------------- /lib/srfi/158.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 158) 2 | (import (scheme base)) 3 | (import (scheme case-lambda)) 4 | (export generator circular-generator make-iota-generator make-range-generator 5 | make-coroutine-generator list->generator vector->generator 6 | reverse-vector->generator string->generator 7 | bytevector->generator 8 | make-for-each-generator make-unfold-generator) 9 | (export gcons* gappend gcombine gfilter gremove 10 | gtake gdrop gtake-while gdrop-while 11 | gflatten ggroup gmerge gmap gstate-filter 12 | gdelete gdelete-neighbor-dups gindex gselect) 13 | (export generator->list generator->reverse-list 14 | generator->vector generator->vector! generator->string 15 | generator-fold generator-map->list generator-for-each generator-find 16 | generator-count generator-any generator-every generator-unfold) 17 | (export make-accumulator count-accumulator list-accumulator 18 | reverse-list-accumulator vector-accumulator 19 | reverse-vector-accumulator vector-accumulator! 20 | string-accumulator bytevector-accumulator bytevector-accumulator! 21 | sum-accumulator product-accumulator) 22 | (include "158.scm") 23 | ) 24 | -------------------------------------------------------------------------------- /lib/srfi/159.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 159) 3 | (import (srfi 159 base) (srfi 159 columnar) 4 | (srfi 159 unicode) (srfi 159 color)) 5 | (export 6 | ;; base 7 | show fn forked with with! each each-in-list call-with-output 8 | displayed written written-simply 9 | numeric numeric/comma numeric/si numeric/fitted 10 | nothing nl fl space-to tab-to escaped maybe-escaped 11 | padded padded/right padded/both 12 | trimmed trimmed/right trimmed/both trimmed/lazy 13 | fitted fitted/right fitted/both 14 | joined joined/prefix joined/suffix joined/last joined/dot joined/range 15 | ;; columnar 16 | call-with-output-generator call-with-output-generators 17 | string->line-generator 18 | tabular columnar show-columns wrapped wrapped/list wrapped/char 19 | justified line-numbers from-file 20 | ;; unicode 21 | as-unicode 22 | ;; color 23 | as-red as-blue as-green as-cyan as-yellow 24 | as-magenta as-white as-black 25 | as-bold as-underline 26 | )) 27 | -------------------------------------------------------------------------------- /lib/srfi/159/color.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 159 color) 3 | (import (scheme base) (srfi 159 base)) 4 | (export as-red as-blue as-green as-cyan as-yellow 5 | as-magenta as-white as-black 6 | as-bold as-underline) 7 | (begin (define (make-state-variable . o) #f)) 8 | (include "../166/color.scm")) 9 | -------------------------------------------------------------------------------- /lib/srfi/159/columnar.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 159 columnar) 3 | (import (scheme base) (scheme char) (scheme file) (scheme write) 4 | (srfi 1) (srfi 117) (srfi 130) (srfi 159 base) 5 | (chibi optional)) 6 | (export 7 | call-with-output-generator call-with-output-generators 8 | string->line-generator 9 | tabular columnar show-columns wrapped wrapped/list wrapped/char 10 | justified line-numbers from-file) 11 | (include "../166/column.scm")) 12 | -------------------------------------------------------------------------------- /lib/srfi/159/unicode.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 159 unicode) 3 | (import (scheme base) 4 | (scheme char) 5 | (chibi show base) 6 | (srfi 130) 7 | (srfi 151)) 8 | (export (rename terminal-aware as-unicode)) 9 | (include "../166/width.scm" "../166/unicode.scm")) 10 | -------------------------------------------------------------------------------- /lib/srfi/16.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 16) 3 | (export case-lambda) 4 | (import (chibi)) 5 | (begin 6 | (define-syntax %case 7 | (syntax-rules () 8 | ((%case args len n p ((params ...) . body) . rest) 9 | (if (= len (length '(params ...))) 10 | (apply (lambda (params ...) . body) args) 11 | (%case args len 0 () . rest))) 12 | ((%case args len n (p ...) ((x . y) . body) . rest) 13 | (%case args len (+ n 1) (p ... x) (y . body) . rest)) 14 | ((%case args len n (p ...) (y . body) . rest) 15 | (if (>= len n) 16 | (apply (lambda (p ... . y) . body) args) 17 | (%case args len 0 () . rest))) 18 | ((%case args len n p) 19 | (error "case-lambda: no cases matched")))) 20 | (define-syntax case-lambda 21 | (syntax-rules () 22 | ((case-lambda . clauses) 23 | (lambda args (let ((len (length* args))) (%case args len 0 () . clauses)))))))) 24 | -------------------------------------------------------------------------------- /lib/srfi/16/test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 16 test) 2 | (export run-tests) 3 | (import (chibi) (chibi test) (srfi 16)) 4 | (begin 5 | (define (run-tests) 6 | (define plus 7 | (case-lambda 8 | (() 0) 9 | ((x) x) 10 | ((x y) (+ x y)) 11 | ((x y z) (+ (+ x y) z)) 12 | (args (apply + args)))) 13 | (define print 14 | (case-lambda 15 | (() 16 | (display "")) 17 | ((arg) 18 | (display arg)) 19 | ((arg . args) 20 | (display arg) 21 | (display " ") 22 | (apply print args)))) 23 | (define (print-to-string . args) 24 | (let ((out (open-output-string)) 25 | (old-out (current-output-port))) 26 | (dynamic-wind 27 | (lambda () (current-output-port out)) 28 | (lambda () (apply print args)) 29 | (lambda () (current-output-port old-out))) 30 | (get-output-string out))) 31 | 32 | (test-begin "srfi-16: case-lambda") 33 | 34 | (test 0 (plus)) 35 | (test 1 (plus 1)) 36 | (test 6 (plus 1 2 3)) 37 | (test-error ((case-lambda ((a) a) ((a b) (* a b))) 1 2 3)) 38 | 39 | (test "" (print-to-string)) 40 | (test "hi" (print-to-string 'hi)) 41 | (test "hi there world" (print-to-string 'hi 'there 'world)) 42 | 43 | (test-end)))) 44 | -------------------------------------------------------------------------------- /lib/srfi/160/prims.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 160 prims) 3 | (export 4 | uvector-length 5 | SEXP_U1 SEXP_S8 SEXP_U8 SEXP_S16 SEXP_U16 6 | SEXP_S32 SEXP_U32 SEXP_S64 SEXP_U64 7 | SEXP_F32 SEXP_F64 SEXP_F8 SEXP_F16 8 | SEXP_C64 SEXP_C128 9 | u1vector? u1vector-ref u1vector-set! 10 | ;; u8vector? u8vector-ref u8vector-set! 11 | s8vector? s8vector-ref s8vector-set! 12 | u16vector? u16vector-ref u16vector-set! 13 | s16vector? s16vector-ref s16vector-set! 14 | u32vector? u32vector-ref u32vector-set! 15 | s32vector? s32vector-ref s32vector-set! 16 | u64vector? u64vector-ref u64vector-set! 17 | s64vector? s64vector-ref s64vector-set! 18 | f8vector? f8vector-ref f8vector-set! 19 | f16vector? f16vector-ref f16vector-set! 20 | f32vector? f32vector-ref f32vector-set! 21 | f64vector? f64vector-ref f64vector-set! 22 | c64vector? c64vector-ref c64vector-set! 23 | c128vector? c128vector-ref c128vector-set! 24 | ) 25 | (include-shared "uvprims")) 26 | -------------------------------------------------------------------------------- /lib/srfi/166/color.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 166 color) 3 | (import (scheme base) (srfi 130) (srfi 166 base)) 4 | (export 5 | ;; foreground 6 | as-red as-blue as-green as-cyan as-yellow 7 | as-magenta as-white as-black 8 | as-bold as-italic as-underline 9 | as-color as-true-color 10 | ;; background 11 | on-red on-blue on-green on-cyan on-yellow 12 | on-magenta on-white on-black 13 | on-color on-true-color 14 | ) 15 | (include "color.scm")) 16 | -------------------------------------------------------------------------------- /lib/srfi/166/columnar.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 166 columnar) 3 | (import (scheme base) 4 | (scheme char) 5 | (scheme file) 6 | (srfi 1) 7 | (srfi 117) 8 | (srfi 130) 9 | (srfi 166 base) 10 | (chibi optional)) 11 | (export 12 | columnar tabular wrapped wrapped/list wrapped/char 13 | justified from-file line-numbers) 14 | (include "column.scm")) 15 | -------------------------------------------------------------------------------- /lib/srfi/166/pretty.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 166 pretty) 3 | (import (scheme base) 4 | (scheme char) 5 | (scheme write) 6 | (chibi show shared) 7 | (srfi 1) 8 | (srfi 69) 9 | (srfi 130) 10 | (srfi 166 base) 11 | (srfi 166 color)) 12 | (export pretty pretty-shared pretty-simply pretty-with-color) 13 | (include "pretty.scm")) 14 | -------------------------------------------------------------------------------- /lib/srfi/166/unicode.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 166 unicode) 3 | (import (scheme base) 4 | (scheme char) 5 | (srfi 130) 6 | (srfi 151) 7 | (srfi 166 base)) 8 | (export terminal-aware 9 | string-terminal-width string-terminal-width/wide 10 | substring-terminal-width substring-terminal-width/wide 11 | substring-terminal-preserve 12 | upcased downcased) 13 | (include "width.scm" 14 | "unicode.scm")) 15 | -------------------------------------------------------------------------------- /lib/srfi/18.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 18) 3 | (export 4 | current-thread thread? make-thread thread-name 5 | thread-specific thread-specific-set! thread-start! 6 | thread-yield! thread-sleep! thread-terminate! 7 | thread-join! mutex? make-mutex mutex-name 8 | mutex-specific mutex-specific-set! mutex-state 9 | mutex-lock! mutex-unlock! condition-variable? 10 | make-condition-variable condition-variable-name 11 | condition-variable-specific condition-variable-specific-set! 12 | condition-variable-signal! condition-variable-broadcast! 13 | current-time time? time->seconds seconds->time 14 | current-exception-handler with-exception-handler raise 15 | join-timeout-exception? abandoned-mutex-exception? 16 | terminated-thread-exception? uncaught-exception? 17 | uncaught-exception-reason) 18 | (cond-expand 19 | (threads 20 | (import (chibi) (srfi 9) (chibi ast) 21 | (except (chibi time) time->seconds seconds->time)) 22 | (include "18/types.scm") 23 | (include-shared "18/threads") 24 | (include "18/interface.scm")) 25 | (else 26 | (error "chibi was not compiled with threading support")))) 27 | -------------------------------------------------------------------------------- /lib/srfi/18/types.scm: -------------------------------------------------------------------------------- 1 | ;; types.scm -- thread types 2 | ;; Copyright (c) 2010-2011 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define-record-type Mutex 6 | (%make-mutex name specific thread lock) 7 | mutex? 8 | (name mutex-name) 9 | (specific mutex-specific mutex-specific-set!) 10 | (thread %mutex-thread %mutex-thread-set!) 11 | (lock %mutex-lock %mutex-lock-set!)) 12 | 13 | (define (make-mutex . o) 14 | (%make-mutex (and (pair? o) (car o)) #f #f #f)) 15 | 16 | (define-record-type Condition-Variable 17 | (%make-condition-variable name specific threads) 18 | condition-variable? 19 | (name condition-variable-name) 20 | (specific condition-variable-specific condition-variable-specific-set!) 21 | (threads %condition-variable-threads %condition-variable-threads-set!)) 22 | 23 | (define (make-condition-variable . o) 24 | (%make-condition-variable (and (pair? o) (car o)) #f #f)) 25 | -------------------------------------------------------------------------------- /lib/srfi/188.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 188) 3 | (import (rename (chibi) 4 | (let-syntax splicing-let-syntax) 5 | (letrec-syntax splicing-letrec-syntax))) 6 | (export splicing-let-syntax splicing-letrec-syntax)) 7 | -------------------------------------------------------------------------------- /lib/srfi/193.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 193) 3 | (export command-line command-name command-args script-file script-directory) 4 | (import (scheme base) (chibi filesystem) (chibi pathname) 5 | (only (chibi) command-line) 6 | (only (meta) raw-script-file)) 7 | (begin 8 | (define start-directory (current-directory)) 9 | 10 | (define (command-name) 11 | (let ((filename (car (command-line)))) 12 | (and (not (= 0 (string-length filename))) 13 | (path-strip-extension (path-strip-directory filename))))) 14 | 15 | (define (command-args) 16 | (cdr (command-line))) 17 | 18 | (define (script-file) 19 | (and raw-script-file 20 | (path-normalize 21 | (path-resolve raw-script-file start-directory)))) 22 | 23 | (define (script-directory) 24 | (let ((filename (script-file))) 25 | (and filename (string-append (path-directory filename) "/")))))) 26 | -------------------------------------------------------------------------------- /lib/srfi/2.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 2) 3 | (export and-let*) 4 | (import (chibi)) 5 | (begin 6 | (define-syntax and-let* 7 | (syntax-rules () 8 | ((and-let* ()) 9 | #t) 10 | ((and-let* () . body) 11 | (let () . body)) 12 | ((and-let* ((var expr))) 13 | expr) 14 | ((and-let* ((expr))) 15 | expr) 16 | ((and-let* (expr)) ; Extension: in SRFI-2 this can only be a var ref 17 | expr) 18 | ((and-let* ((var expr) . rest) . body) 19 | (let ((var expr)) 20 | (and var (and-let* rest . body)))) 21 | ((and-let* ((expr) . rest) . body) 22 | (and expr (and-let* rest . body))) 23 | ((and-let* (expr . rest) . body) ; Same extension as above 24 | (let ((tmp expr)) 25 | (and tmp (and-let* rest . body)))))))) 26 | -------------------------------------------------------------------------------- /lib/srfi/211/identifier-syntax.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 211 identifier-syntax) 2 | (export identifier-syntax) 3 | (import (only (chibi ast) identifier-syntax))) 4 | 5 | ;; Local Variables: 6 | ;; mode: scheme 7 | ;; End: 8 | -------------------------------------------------------------------------------- /lib/srfi/211/test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 211 test) 2 | (export run-tests) 3 | (import (scheme base) 4 | (only (chibi) er-macro-transformer) 5 | (srfi 211 variable-transformer) 6 | (srfi 211 identifier-syntax) 7 | (chibi test)) 8 | (begin 9 | (define (run-tests) 10 | (test-begin "srfi-211") 11 | 12 | (test '(1 2) 13 | (let-syntax 14 | ((foo (identifier-syntax (list 1 2)))) 15 | foo)) 16 | 17 | (test '(5 5) 18 | (let ((x 3)) 19 | (let-syntax 20 | ((foo (identifier-syntax 21 | (_ x) 22 | ((set! _ e) (set! x e))))) 23 | (set! foo (+ foo 2)) 24 | (list foo x)))) 25 | 26 | (test 42 27 | (let-syntax 28 | ((foo (make-variable-transformer 29 | (er-macro-transformer 30 | (lambda (e r c) 31 | (list-ref e 2)))))) 32 | (set! foo 42))) 33 | 34 | (test-end)))) 35 | 36 | ;; Local Variables: 37 | ;; mode: scheme 38 | ;; End: 39 | -------------------------------------------------------------------------------- /lib/srfi/211/variable-transformer.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 211 variable-transformer) 2 | (export make-variable-transformer) 3 | (import (only (chibi ast) make-variable-transformer))) 4 | 5 | ;; Local Variables: 6 | ;; mode: scheme 7 | ;; End: 8 | -------------------------------------------------------------------------------- /lib/srfi/219.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 219) 2 | (export define) 3 | (import (rename (scheme base) (define native-define))) 4 | (begin (define-syntax define 5 | (syntax-rules () 6 | ((define ((name . outer-args) . args) . body) 7 | (define (name . outer-args) (lambda args . body))) 8 | ((define head . body) 9 | (native-define head . body)))))) 10 | -------------------------------------------------------------------------------- /lib/srfi/219/test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 219 test) 2 | (export run-tests) 3 | (import (chibi) (chibi test) (rename (srfi 219) (define define-219))) 4 | (begin 5 | (define (run-tests) 6 | (test-group 7 | "srfi-219: define higher-order lambda" 8 | 9 | (let () 10 | (define-219 ((greet/prefix prefix) suffix) 11 | (string-append prefix " " suffix)) 12 | (let ((greet (greet/prefix "Hello"))) 13 | (test "Hello there!" (greet "there!")))) 14 | 15 | (let () 16 | (define-219 ((append-to . a) . b) 17 | (apply append (append a b))) 18 | (test '() 19 | ((append-to '()) '())) 20 | (test '(1 2 3 4 5 6 7 8) 21 | ((append-to '(1 2) '(3 4)) '(5 6) '(7 8)))) 22 | 23 | (let () 24 | (define-219 (((jenga a b) c d)) 25 | (list a b c d)) 26 | (test '(1 2 3 4) 27 | (((jenga 1 2) 3 4)))))))) 28 | -------------------------------------------------------------------------------- /lib/srfi/227.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 227) 2 | (export opt-lambda 3 | (rename opt-lambda* opt*-lambda) 4 | let-optionals 5 | let-optionals*) 6 | (import (chibi optional))) 7 | -------------------------------------------------------------------------------- /lib/srfi/227/definition.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 227 definition) 2 | (export (rename define-opt define-optionals) 3 | (rename define-opt* define-optionals*)) 4 | (import (chibi optional))) 5 | -------------------------------------------------------------------------------- /lib/srfi/229/test.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 229 test) 3 | (import (scheme base) (srfi 229) (chibi test)) 4 | (export run-tests) 5 | (begin 6 | (define (run-tests . o) 7 | (test-begin "(srfi 229)") 8 | (let () 9 | (define f 10 | (lambda/tag 42 11 | (x) 12 | (* x x))) 13 | (define f* 14 | (lambda/tag 43 15 | (x) 16 | (* x x))) 17 | (define g 18 | (lambda/tag 44 args (apply list args))) 19 | (test-assert (procedure/tag? f)) 20 | (test-not (procedure/tag? (lambda (x) (* x x)))) 21 | (test-not (procedure/tag? +)) 22 | (test 9 (f 3)) 23 | (test 42 (procedure-tag f)) 24 | (test-not (eqv? f f*)) 25 | (test 43 (procedure-tag f*)) 26 | (test 44 (procedure-tag g)) 27 | (test '(1) (g 1)) 28 | (test '(1 2 3) (g 1 2 3))) 29 | (test-end)))) 30 | -------------------------------------------------------------------------------- /lib/srfi/23.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 23) 3 | (import (scheme base)) 4 | (export error)) 5 | -------------------------------------------------------------------------------- /lib/srfi/26.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 26) 3 | (export cut cute) 4 | (import (chibi)) 5 | (begin 6 | (define-syntax %cut 7 | (syntax-rules (<> <...>) 8 | ((%cut e? params args) 9 | (lambda params args)) 10 | ((%cut e? (params ...) (args ...) <> . rest) 11 | (%cut e? (params ... tmp) (args ... tmp) . rest)) 12 | ((%cut e? (params ...) (args ...) <...>) 13 | (%cut e? (params ... . tmp) (apply args ... tmp))) 14 | ((%cut e? (params ...) (args ...) <...> . rest) 15 | (error "cut: non-terminal <...>")) 16 | ((%cut #t (params ...) (args ...) x . rest) 17 | (let ((tmp x)) (%cut #t (params ...) (args ... tmp) . rest))) 18 | ((%cut #f (params ...) (args ...) x . rest) 19 | (%cut #f (params ...) (args ... x) . rest)))) 20 | (define-syntax cut 21 | (syntax-rules () ((cut args ...) (%cut #f () () args ...)))) 22 | (define-syntax cute 23 | (syntax-rules () ((cute args ...) (%cut #t () () args ...)))))) 24 | -------------------------------------------------------------------------------- /lib/srfi/26/test.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 26 test) 2 | (export run-tests) 3 | (import (chibi) (srfi 26) (chibi test)) 4 | (begin 5 | (define (run-tests) 6 | (test-begin "srfi-26: cut") 7 | (let ((x 'orig)) 8 | (let ((f (cute list x))) 9 | (set! x 'wrong) 10 | (test '(orig) (f)))) 11 | (let ((x 'wrong)) 12 | (let ((f (cut list x))) 13 | (set! x 'right) 14 | (test '(right) (f)))) 15 | (test-end)))) 16 | -------------------------------------------------------------------------------- /lib/srfi/27.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 27) 3 | (export random-integer random-real default-random-source 4 | make-random-source random-source? 5 | random-source-state-ref random-source-state-set! 6 | random-source-randomize! random-source-pseudo-randomize! 7 | random-source-make-integers random-source-make-reals) 8 | (import (chibi)) 9 | (include-shared "27/rand") 10 | (include "27/constructors.scm")) 11 | -------------------------------------------------------------------------------- /lib/srfi/27/constructors.scm: -------------------------------------------------------------------------------- 1 | ;; constructors.scm -- random function constructors 2 | ;; Copyright (c) 2009 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (random-source-make-integers rs) 6 | (if (not (random-source? rs)) 7 | (error "not a random source" rs)) 8 | (lambda (n) (%random-integer rs n))) 9 | 10 | (define (random-source-make-reals rs . o) 11 | (if (not (random-source? rs)) 12 | (error "not a random source" rs)) 13 | (lambda () (%random-real rs))) 14 | 15 | -------------------------------------------------------------------------------- /lib/srfi/35.sld: -------------------------------------------------------------------------------- 1 | (define-library (srfi 35) 2 | (import (srfi 35 internal)) 3 | (export make-condition-type 4 | condition-type? 5 | make-condition 6 | condition? 7 | condition-has-type? 8 | condition-ref 9 | make-compound-condition 10 | extract-condition 11 | define-condition-type 12 | condition 13 | 14 | &condition 15 | 16 | &message 17 | message-condition? 18 | condition-message 19 | 20 | &serious 21 | serious-condition? 22 | 23 | &error 24 | error?)) 25 | -------------------------------------------------------------------------------- /lib/srfi/38.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 38) 3 | (import (chibi) (srfi 69) (chibi ast)) 4 | (export write-with-shared-structure write/ss 5 | read-with-shared-structure read/ss) 6 | (include "38.scm") 7 | (cond-expand 8 | (uvector 9 | ) 10 | (else 11 | (begin 12 | (define (list->uvector etype ls) 13 | (if (eq? etype U8) 14 | (let* ((len (length ls)) 15 | (bv (make-bytevector len))) 16 | (do ((i 0 (+ i 1)) (ls ls (cdr ls))) 17 | ((null? ls) bv) 18 | (bytevector-u8-set! bv i (car ls)))) 19 | (list->vector ls))))))) 20 | -------------------------------------------------------------------------------- /lib/srfi/39.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 39) 3 | (export make-parameter parameterize) 4 | (import (chibi)) 5 | (include-shared "39/param") 6 | (cond-expand 7 | (threads 8 | (include "39/syntax.scm")) 9 | (else 10 | (include "39/syntax-no-threads.scm")))) 11 | -------------------------------------------------------------------------------- /lib/srfi/39/syntax.scm: -------------------------------------------------------------------------------- 1 | ;; param.scm -- SRFI-39 parameters 2 | ;; Copyright (c) 2010 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define (parameter-convert param value) 6 | (let ((proc (parameter-converter param))) 7 | (if (procedure? proc) 8 | (proc value) 9 | value))) 10 | 11 | (define (make-parameter init . o) 12 | (let ((conv (and (pair? o) (car o)))) 13 | (%make-parameter (if conv (conv init) init) conv))) 14 | 15 | (define-syntax parameterize 16 | (syntax-rules () 17 | ((parameterize ("step") old cons-new ((param value ptmp vtmp) ...) () body) 18 | (let ((ptmp param) ...) 19 | (let ((vtmp (parameter-convert ptmp value)) ...) 20 | (let ((old (thread-parameters))) 21 | (let ((new cons-new)) 22 | (dynamic-wind 23 | (lambda () (thread-parameters-set! new)) 24 | (lambda () . body) 25 | (lambda () (thread-parameters-set! old)))))))) 26 | ((parameterize ("step") old cons-new args ((param value) . rest) body) 27 | (parameterize ("step") old (cons (cons ptmp vtmp) cons-new) ((param value ptmp vtmp) . args) rest body)) 28 | ((parameterize ((param value) ...) . body) 29 | (parameterize ("step") old (thread-parameters) () ((param value) ...) body)))) 30 | -------------------------------------------------------------------------------- /lib/srfi/41.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 41) 3 | (import (scheme base) (scheme lazy) (srfi 1)) 4 | (export 5 | stream-null stream-cons stream? stream-null? stream-pair? 6 | stream-car stream-cdr stream-lambda) 7 | (export 8 | define-stream list->stream port->stream stream stream->list 9 | stream-append stream-concat stream-constant stream-drop 10 | stream-drop-while stream-filter stream-fold stream-for-each stream-from 11 | stream-iterate stream-length stream-let stream-map stream-match _ 12 | stream-of stream-range stream-ref stream-reverse stream-scan stream-take 13 | stream-take-while stream-unfold stream-unfolds stream-zip) 14 | (include "41.scm")) 15 | -------------------------------------------------------------------------------- /lib/srfi/46.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 46) 3 | (import (chibi)) 4 | (export syntax-rules)) 5 | -------------------------------------------------------------------------------- /lib/srfi/55.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 55) 3 | (export require-extension) 4 | (import (chibi)) 5 | (begin 6 | (define-syntax require-extension 7 | (syntax-rules () 8 | ((require-extension (prefix mod ...)) 9 | (begin (import (prefix mod) ...))))))) 10 | -------------------------------------------------------------------------------- /lib/srfi/6.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 6) 3 | (export open-input-string open-output-string get-output-string) 4 | (import (chibi))) 5 | -------------------------------------------------------------------------------- /lib/srfi/69.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 69) 3 | (export hash-table-cell 4 | make-hash-table hash-table? alist->hash-table 5 | hash-table-equivalence-function hash-table-hash-function 6 | hash-table-ref hash-table-ref/default hash-table-set! 7 | hash-table-delete! hash-table-exists? 8 | hash-table-update! hash-table-update!/default 9 | hash-table-size hash-table-keys hash-table-values 10 | hash-table-walk hash-table-fold hash-table->alist 11 | hash-table-copy hash-table-merge! 12 | hash string-hash string-ci-hash hash-by-identity) 13 | (import (chibi) (srfi 9)) 14 | (include-shared "69/hash") 15 | (include "69/type.scm" "69/interface.scm")) 16 | -------------------------------------------------------------------------------- /lib/srfi/69/type.scm: -------------------------------------------------------------------------------- 1 | ;; types.scm -- the hash-table record type 2 | ;; Copyright (c) 2009-2011 Alex Shinn. All rights reserved. 3 | ;; BSD-style license: http://synthcode.com/license.txt 4 | 5 | (define-record-type Hash-Table 6 | (%make-hash-table buckets size hash-fn eq-fn) 7 | hash-table? 8 | (buckets hash-table-buckets hash-table-buckets-set!) 9 | (size hash-table-size hash-table-size-set!) 10 | (hash-fn %hash-table-hash-function) 11 | (eq-fn %hash-table-equivalence-function)) 12 | 13 | -------------------------------------------------------------------------------- /lib/srfi/8.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 8) 3 | (export receive) 4 | (import (chibi)) 5 | (body 6 | (define-syntax receive 7 | (syntax-rules () 8 | ((receive params expr . body) 9 | (call-with-values (lambda () expr) (lambda params . body))))))) 10 | -------------------------------------------------------------------------------- /lib/srfi/9.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 9) 3 | (export define-record-type) 4 | (import (chibi)) 5 | (include "9.scm")) 6 | -------------------------------------------------------------------------------- /lib/srfi/95.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 95) 3 | (export sorted? merge merge! sort sort! object-cmp) 4 | (import (chibi)) 5 | (include-shared "95/qsort") 6 | (include "95/sort.scm")) 7 | -------------------------------------------------------------------------------- /lib/srfi/98.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 98) 3 | (export get-environment-variable get-environment-variables) 4 | (include-shared "98/env")) 5 | -------------------------------------------------------------------------------- /lib/srfi/99.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 99) 3 | (import (srfi 99 records)) 4 | (export make-rtd rtd? rtd-constructor rtd-predicate rtd-accessor rtd-mutator 5 | record? record-rtd rtd-name rtd-parent 6 | rtd-field-names rtd-all-field-names rtd-field-mutable? 7 | define-record-type)) 8 | -------------------------------------------------------------------------------- /lib/srfi/99/records.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 99 records) 3 | (import (srfi 99 records procedural) 4 | (srfi 99 records inspection) 5 | (srfi 99 records syntactic)) 6 | (export make-rtd rtd? rtd-constructor rtd-predicate rtd-accessor rtd-mutator 7 | record? record-rtd rtd-name rtd-parent 8 | rtd-field-names rtd-all-field-names rtd-field-mutable? 9 | define-record-type)) 10 | -------------------------------------------------------------------------------- /lib/srfi/99/records/inspection.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (record? x) 3 | (is-a? x Object)) 4 | 5 | (define (record-rtd x) 6 | (type-of x)) 7 | 8 | (define (rtd-name x) (string->symbol (type-name x))) 9 | 10 | (define (rtd-parent x) (type-parent x)) 11 | 12 | (define (rtd-field-names x) 13 | (list->vector 14 | (map (lambda (x) (if (pair? x) (cadr x) x)) (type-slots x)))) 15 | 16 | (define (rtd-all-field-names x) 17 | (let lp ((x x) (res '())) 18 | (let ((res (append (vector->list (rtd-field-names x)) res))) 19 | (let ((p (type-parent x))) 20 | (if (type? p) 21 | (lp p res) 22 | (list->vector res)))))) 23 | 24 | (define (rtd-field-mutable? rtd x) 25 | (let lp ((ls (type-slots rtd))) 26 | (cond ((null? ls) 27 | (let ((p (type-parent rtd))) 28 | (if (type? p) 29 | (rtd-field-mutable? p x) 30 | (error "unknown field" rtd x)))) 31 | ((eq? x (car ls))) 32 | ((and (pair? (car ls)) (eq? x (cadr (car ls)))) 33 | (not (eq? 'immutable (caar ls)))) 34 | (else (lp (cdr ls)))))) 35 | -------------------------------------------------------------------------------- /lib/srfi/99/records/inspection.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 99 records inspection) 3 | (export record? record-rtd rtd-name rtd-parent 4 | rtd-field-names rtd-all-field-names rtd-field-mutable?) 5 | (import (chibi) (chibi ast)) 6 | (include "inspection.scm")) 7 | -------------------------------------------------------------------------------- /lib/srfi/99/records/procedural.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 99 records procedural) 3 | (export make-rtd rtd? rtd-constructor rtd-predicate rtd-accessor rtd-mutator) 4 | (import (chibi) 5 | (chibi ast) 6 | (only (srfi 1) iota) 7 | (srfi 99 records inspection)) 8 | (include "procedural.scm")) 9 | -------------------------------------------------------------------------------- /lib/srfi/99/records/syntactic.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (srfi 99 records syntactic) 3 | (export define-record-type) 4 | (import (chibi) (srfi 99 records inspection)) 5 | (include "syntactic.scm")) 6 | -------------------------------------------------------------------------------- /opt/opcode_names.h: -------------------------------------------------------------------------------- 1 | 2 | static const char* sexp_opcode_names_[] = 3 | {"NOOP", "RAISE", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL", 4 | "FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "FCALLN", 5 | "JUMP-UNLESS", "JUMP", "PUSH", "RESERVE", "DROP", 6 | "GLOBAL-REF", "GLOBAL-KNOWN-REF", "PARAMETER-REF", "STACK-REF", 7 | "LOCAL-REF", "LOCAL-SET", "CLOSURE-REF", "CLOSURE-VARS", 8 | "VECTOR-REF", "VECTOR-SET", "VECTOR-LENGTH", 9 | "BYTES-REF", "BYTES-SET", "BYTES-LENGTH", 10 | "STRING-REF", "STRING-SET", "STRING-LENGTH", 11 | "STRING-CURSOR-NEXT", "STRING-CURSOR-PREV", "STRING-CURSOR-END", 12 | "MAKE-PROCEDURE", "MAKE-VECTOR", 13 | "MAKE-EXCEPTION", "AND", "NULL?", "FIXNUM?", "SYMBOL?", "CHAR?", 14 | "EOF?", "TYPEP", "MAKE", "SLOT-REF", "SLOT-SET", 15 | "ISA?", "SLOTN-REF", "SLOTN-SET", 16 | "CAR", "CDR", "SET-CAR", "SET-CDR", "CONS", 17 | "ADD", "SUB", "MUL", "DIV", "QUOTIENT", "REMAINDER", 18 | "LT", "LE", "EQN", "EQ", 19 | "CHAR->INTEGER", "INTEGER->CHAR", "CHAR-UPCASE", "CHAR-DOWNCASE", 20 | "WRITE-CHAR", "WRITE-STRING", "READ-CHAR", "PEEK-CHAR", 21 | "YIELD", "FORCE", "RET", "DONE", "SC?", "SC<", "SC<=" 22 | }; 23 | 24 | const char** sexp_opcode_names = sexp_opcode_names_; 25 | -------------------------------------------------------------------------------- /opt/plan9-opcodes.c: -------------------------------------------------------------------------------- 1 | _FN0(_I(SEXP_FIXNUM), "random-integer", 0, sexp_rand), 2 | _FN1(_I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "random-seed", 0, sexp_srand), 3 | _FN0(_I(SEXP_STRING), "current-directory", 0, sexp_getwd), 4 | _FN0(_I(SEXP_STRING), "current-user", 0, sexp_getuser), 5 | _FN0(_I(SEXP_STRING), "system-name", 0, sexp_sysname), 6 | _FN1(_I(SEXP_FIXNUM), _I(SEXP_IPORT), "port-fileno", 0, sexp_fileno), 7 | _FN2(_I(SEXP_IPORT), _I(SEXP_FIXNUM), _I(SEXP_STRING), "fileno->port", 0, sexp_fdopen), 8 | _FN0(_I(SEXP_FIXNUM), "fork", 0, sexp_fork), 9 | _FN2(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_PAIR), "exec", 0, sexp_exec), 10 | _FN1(SEXP_VOID, _I(SEXP_STRING), "exits", 0, sexp_exits), 11 | _FN2(_I(SEXP_FIXNUM), _I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "dup", 0, sexp_dup), 12 | _FN0(_I(SEXP_PAIR), "pipe", 0, sexp_pipe), 13 | _FN1(_I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "sleep", 0, sexp_sleep), 14 | _FN1(_I(SEXP_STRING), _I(SEXP_STRING), "getenv", 0, sexp_getenv), 15 | _FN1(_I(SEXP_FIXNUM), _I(SEXP_STRING), "change-directory", 0, sexp_chdir), 16 | _FN0(_I(SEXP_FIXNUM), "wait", 0, sexp_wait), 17 | _FN2(_I(SEXP_FIXNUM), _I(SEXP_FIXNUM), _I(SEXP_STRING), "post-note", 0, sexp_postnote), 18 | _FN4(_I(SEXP_FIXNUM), _I(SEXP_PAIR), _I(SEXP_STRING), _I(SEXP_STRING), "%postmountsrv", 0, sexp_postmountsrv), 19 | _FN1(_I(SEXP_FIXNUM), _I(SEXP_STRING), "file-exists?", 0, sexp_file_exists_p), 20 | -------------------------------------------------------------------------------- /tests/basic/test00-fact-3.res: -------------------------------------------------------------------------------- 1 | (fact 3) => 6 2 | -------------------------------------------------------------------------------- /tests/basic/test00-fact-3.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (fact-helper x res) 3 | (if (= x 0) 4 | res 5 | (fact-helper (- x 1) (* res x)))) 6 | 7 | (define (fact x) 8 | (fact-helper x 1)) 9 | 10 | (display "(fact 3) => ") 11 | (write (fact 3)) 12 | (newline) 13 | 14 | 15 | -------------------------------------------------------------------------------- /tests/basic/test01-apply.res: -------------------------------------------------------------------------------- 1 | 11 2 | (11 10 9 8 7 6 5 4 3 2 1) 3 | (1 2 3 4) 4 | 100 5 | 100 6 | 100 7 | 100 8 | 100 9 | -------------------------------------------------------------------------------- /tests/basic/test01-apply.scm: -------------------------------------------------------------------------------- 1 | 2 | (define foo 3 | (lambda (a b c d e f g h) 4 | (+ (+ (* a b) (* c d)) (+ (* e f) (* g h))))) 5 | 6 | (define (writeln x) 7 | (write x) 8 | (newline)) 9 | 10 | (writeln (length (reverse (list 1 2 3 4 5 6 7 8 9 10 11)))) 11 | (writeln (reverse (list 1 2 3 4 5 6 7 8 9 10 11))) 12 | (writeln (append (list 1 2) (list 3 4))) 13 | (writeln (foo 1 2 3 4 5 6 7 8)) 14 | (writeln (apply foo (list 1 2 3 4 5 6 7 8))) 15 | (writeln (apply foo 1 (list 2 3 4 5 6 7 8))) 16 | (writeln (apply foo 1 2 3 4 (list 5 6 7 8))) 17 | (writeln (apply foo 1 2 3 4 5 (list 6 7 8))) 18 | 19 | -------------------------------------------------------------------------------- /tests/basic/test02-closure.res: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 101 4 | 102 5 | 3 6 | 103 7 | -------------------------------------------------------------------------------- /tests/basic/test02-closure.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (make-counter n) 3 | (lambda () 4 | (set! n (+ n 1)) 5 | n)) 6 | 7 | (define f (make-counter 0)) 8 | (define g (make-counter 100)) 9 | 10 | (write (f)) (newline) 11 | (write (f)) (newline) 12 | (write (g)) (newline) 13 | (write (g)) (newline) 14 | (write (f)) (newline) 15 | (write (g)) (newline) 16 | 17 | -------------------------------------------------------------------------------- /tests/basic/test03-nested-closure.res: -------------------------------------------------------------------------------- 1 | 11357 2 | -------------------------------------------------------------------------------- /tests/basic/test03-nested-closure.scm: -------------------------------------------------------------------------------- 1 | 2 | ((lambda (a b) 3 | ((lambda (c d e) 4 | (write (+ e (* c 1000) (* a 100) (* b 10) d)) 5 | (newline)) 6 | (- a 2) (+ b 2) 10000)) 7 | 3 5) 8 | 9 | -------------------------------------------------------------------------------- /tests/basic/test04-nested-let.res: -------------------------------------------------------------------------------- 1 | 11357 2 | -------------------------------------------------------------------------------- /tests/basic/test04-nested-let.scm: -------------------------------------------------------------------------------- 1 | 2 | (let ((a 3) 3 | (b 5)) 4 | (let ((c (- a 2)) 5 | (d (+ b 2)) 6 | (e 10000)) 7 | (write (+ e (* c 1000) (* a 100) (* b 10) d)) 8 | (newline))) 9 | 10 | -------------------------------------------------------------------------------- /tests/basic/test05-internal-define.res: -------------------------------------------------------------------------------- 1 | 1000 1003 2 | -------------------------------------------------------------------------------- /tests/basic/test05-internal-define.scm: -------------------------------------------------------------------------------- 1 | 2 | (let ((a 1000)) 3 | (define b (+ a 3)) 4 | (write a) 5 | (display " ") 6 | (write b) 7 | (newline)) 8 | 9 | -------------------------------------------------------------------------------- /tests/basic/test06-letrec.res: -------------------------------------------------------------------------------- 1 | 7 2 | #t 3 | #f 4 | #f 5 | -------------------------------------------------------------------------------- /tests/basic/test06-letrec.scm: -------------------------------------------------------------------------------- 1 | 2 | (letrec ((add (lambda (a b) (+ a b)))) 3 | (write (add 3 4)) 4 | (newline)) 5 | 6 | (letrec ((even? (lambda (n) (if (zero? n) #t (odd? (- n 1))))) 7 | (odd? (lambda (n) (if (zero? n) #f (even? (- n 1)))))) 8 | (write (even? 1000)) 9 | (newline) 10 | (write (even? 1001)) 11 | (newline) 12 | (write (odd? 1000)) 13 | (newline) 14 | ) 15 | 16 | -------------------------------------------------------------------------------- /tests/basic/test07-mutation.res: -------------------------------------------------------------------------------- 1 | 11357 2 | -------------------------------------------------------------------------------- /tests/basic/test07-mutation.scm: -------------------------------------------------------------------------------- 1 | 2 | (let ((a 3) 3 | (b 5)) 4 | (let ((c (- a 2)) 5 | (d (+ b 2)) 6 | (e #f)) 7 | (set! e 10000) 8 | (write (+ e (* c 1000) (* a 100) (* b 10) d)) 9 | (newline))) 10 | -------------------------------------------------------------------------------- /tests/basic/test08-callcc.res: -------------------------------------------------------------------------------- 1 | 543 2 | -------------------------------------------------------------------------------- /tests/basic/test08-callcc.scm: -------------------------------------------------------------------------------- 1 | 2 | (define fail 3 | (lambda () 999999)) 4 | 5 | (define in-range 6 | (lambda (a b) 7 | (call-with-current-continuation 8 | (lambda (cont) 9 | (enumerate a b cont))))) 10 | 11 | (define enumerate 12 | (lambda (a b cont) 13 | (if (< b a) 14 | (fail) 15 | (let ((save fail)) 16 | (begin 17 | (set! fail 18 | (lambda () 19 | (begin 20 | (set! fail save) 21 | (enumerate (+ a 1) b cont)))) 22 | (cont a)))))) 23 | 24 | (write 25 | (let ((x (in-range 2 9)) 26 | (y (in-range 2 9)) 27 | (z (in-range 2 9))) 28 | (if (= (* x x) 29 | (+ (* y y) (* z z))) 30 | (+ (* x 100) (+ (* y 10) z)) 31 | (fail)))) 32 | 33 | (newline) 34 | 35 | -------------------------------------------------------------------------------- /tests/basic/test09-hygiene.res: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 3 4 | 4 5 | 5 6 | 6 7 | outer 8 | -------------------------------------------------------------------------------- /tests/basic/test10-unhygiene.res: -------------------------------------------------------------------------------- 1 | 1 2 | 1 3 | 1 4 | 6 5 | 7 6 | 8 7 | -------------------------------------------------------------------------------- /tests/install/run-install-test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | export PATH=/usr/local/bin:$PATH 4 | export LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH 5 | 6 | tar xzvf chibi-scheme-@VERSION@.tgz 7 | cd chibi-scheme-@VERSION@ 8 | make 9 | make install 10 | cp tests/r5rs-tests.scm .. 11 | cd .. 12 | chibi-scheme r5rs-tests.scm | tee r5rs-tests.out 13 | -------------------------------------------------------------------------------- /tests/memory/memory-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | for f in tests/memory/*.scm; do 4 | ./chibi-scheme-ulimit -q $f >${f%.scm}.out 2>${f%.scm}.err 5 | if diff -q ${f%.scm}.out ${f%.scm}.res \ 6 | && diff -q ${f%.scm}.err ${f%.scm}.err-res; then 7 | echo "[PASS] ${f%.scm}" 8 | rm -f ${f%.scm}.out ${f%.scm}.err 9 | else 10 | echo "[FAIL] ${f%.scm}" 11 | fi 12 | done 13 | -------------------------------------------------------------------------------- /tests/memory/test00-read-string.err-res: -------------------------------------------------------------------------------- 1 | ERROR: out of memory 2 | called from on line 230 of file ./lib/init-7.scm 3 | called from on line 15 of file tests/memory/test00-read-string.scm 4 | called from on line 1076 of file ./lib/init-7.scm 5 | called from on line 230 of file ./lib/init-7.scm 6 | called from on line 640 of file ./lib/init-7.scm 7 | -------------------------------------------------------------------------------- /tests/memory/test00-read-string.res: -------------------------------------------------------------------------------- 1 | string: "aaa... 2 | -------------------------------------------------------------------------------- /tests/memory/test00-read-string.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (show-string str) 3 | (display "string: ") 4 | (display (substring str 0 (min (string-length str) 4))) 5 | (display "...\n")) 6 | 7 | (define str-length (inexact->exact (round (* 2 1024 1024)))) ;; 2MB 8 | (define str1 9 | (let ((tmp (make-string str-length #\a))) 10 | (string-set! tmp 0 #\") 11 | (string-set! tmp (- str-length 1) #\") 12 | tmp)) 13 | (show-string str1) 14 | 15 | (define str2 (call-with-input-string str1 read)) 16 | (show-string str2) 17 | -------------------------------------------------------------------------------- /tests/memory/test01-read-symbol.err-res: -------------------------------------------------------------------------------- 1 | ERROR: out of memory 2 | called from on line 230 of file ./lib/init-7.scm 3 | called from on line 11 of file tests/memory/test01-read-symbol.scm 4 | called from on line 1076 of file ./lib/init-7.scm 5 | called from on line 230 of file ./lib/init-7.scm 6 | called from on line 640 of file ./lib/init-7.scm 7 | -------------------------------------------------------------------------------- /tests/memory/test01-read-symbol.res: -------------------------------------------------------------------------------- 1 | string: aaaa... 2 | -------------------------------------------------------------------------------- /tests/memory/test01-read-symbol.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (show-string str) 3 | (display "string: ") 4 | (display (substring str 0 (min (string-length str) 4))) 5 | (display "...\n")) 6 | 7 | (define str-length (inexact->exact (round (* 2 1024 1024)))) ;; 2MB 8 | (define str1 (make-string str-length #\a)) 9 | (show-string str1) 10 | 11 | (define str2 (call-with-input-string str1 read)) 12 | (show-string str2) 13 | -------------------------------------------------------------------------------- /tests/run/command-line-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Test chibi-scheme command-line options. 4 | # Should be run from a standard build. 5 | 6 | TESTDIR=$(dirname $0) 7 | FAILURES=0 8 | i=0 9 | 10 | run_chibi() { 11 | LD_LIBRARY_PATH=.:$LD_LIBRARY_PATH DYLD_LIBRARY_PATH=.:$DYLD_LIBRARY_PATH CHIBI_MODULE_PATH=lib ./chibi-scheme "$@" 12 | } 13 | 14 | for t in $TESTDIR/*.args; do 15 | IFS=$'\n' read -d '' -r -a args < $t 16 | run_chibi "${args[@]}" 2> ${t%.args}.err > ${t%.args}.out 17 | if diff -w -q ${t%.args}.out ${t%.args}.res \ 18 | && ([ ! -e ${t%.args}.err-res ] || \ 19 | diff -w -q ${t%.args}.err ${t%.args}.err-res); then 20 | echo "[PASS] $(basename ${t%.args})" 21 | else 22 | echo chibi "${args[@]}" 23 | echo "[FAIL] $(basename ${t%.args})" 24 | FAILURES=$((FAILURES + 1)) 25 | fi 26 | i=$((i+1)) 27 | done 28 | 29 | if [ $FAILURES = 0 ]; then 30 | echo "command-line-tests: all ${i} tests passed" 31 | else 32 | echo "command-line-tests: ${FAILURES} out of ${i} tests failed" 33 | exit 1 34 | fi 35 | -------------------------------------------------------------------------------- /tests/run/lib/fact.sld: -------------------------------------------------------------------------------- 1 | (define-library (fact) 2 | (export fact) 3 | (import (scheme base)) 4 | (begin 5 | (define (fact n) 6 | (if (< n 2) 7 | 1 8 | (* n (fact (- n 1))))))) 9 | -------------------------------------------------------------------------------- /tests/run/lib/fib.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (if (< n 2) 3 | 1 4 | (+ (fib (- n 1)) (fib (- n 2))))) 5 | -------------------------------------------------------------------------------- /tests/run/lib/hello.sld: -------------------------------------------------------------------------------- 1 | (define-library (hello) 2 | (import (scheme base)) 3 | (begin 4 | (define (main args) 5 | (write-string "Hello, ") 6 | (write-string (if (pair? (cdr args)) (cadr args) "world!")) 7 | (newline)) 8 | (define (bye args) 9 | (write-string "Goodbye, ") 10 | (write-string (if (pair? (cdr args)) (cadr args) "world!")) 11 | (newline)))) 12 | -------------------------------------------------------------------------------- /tests/run/test00-p.args: -------------------------------------------------------------------------------- 1 | -p 2 | (map (lambda (x) (* x x)) '(0 1 2 3 4 5)) -------------------------------------------------------------------------------- /tests/run/test00-p.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) -------------------------------------------------------------------------------- /tests/run/test01-p-short.args: -------------------------------------------------------------------------------- 1 | -p(map (lambda (x) (* x x)) '(0 1 2 3 4 5)) 2 | -------------------------------------------------------------------------------- /tests/run/test01-p-short.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) -------------------------------------------------------------------------------- /tests/run/test02-h.args: -------------------------------------------------------------------------------- 1 | -h1M 2 | -p(map (lambda (x) (* x x)) '(0 1 2 3 4 5)) 3 | -------------------------------------------------------------------------------- /tests/run/test02-h.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) -------------------------------------------------------------------------------- /tests/run/test03-q.args: -------------------------------------------------------------------------------- 1 | -q 2 | -p(map (lambda (x) (* x x)) '(0 1 2 3 4 5)) 3 | -------------------------------------------------------------------------------- /tests/run/test03-q.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) 2 | -------------------------------------------------------------------------------- /tests/run/test04-Q.args: -------------------------------------------------------------------------------- 1 | -Q 2 | -p(+ 2 2) 3 | -------------------------------------------------------------------------------- /tests/run/test04-Q.res: -------------------------------------------------------------------------------- 1 | 4 -------------------------------------------------------------------------------- /tests/run/test05-xscheme-r5rs.args: -------------------------------------------------------------------------------- 1 | -x(scheme r5rs) 2 | -p(map (lambda (x) (* x x)) '(0 1 2 3 4 5)) 3 | -------------------------------------------------------------------------------- /tests/run/test05-xscheme-r5rs.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) -------------------------------------------------------------------------------- /tests/run/test06-xscheme-base.args: -------------------------------------------------------------------------------- 1 | -xscheme.base 2 | -p(map (lambda (x) (* x x)) '(0 1 2 3 4 5)) 3 | -------------------------------------------------------------------------------- /tests/run/test06-xscheme-base.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) -------------------------------------------------------------------------------- /tests/run/test07-xchibi.args: -------------------------------------------------------------------------------- 1 | -x(chibi) 2 | -p(map (lambda (x) (* x x)) '(0 1 2 3 4 5)) 3 | -------------------------------------------------------------------------------- /tests/run/test07-xchibi.res: -------------------------------------------------------------------------------- 1 | (0 1 4 9 16 25) -------------------------------------------------------------------------------- /tests/run/test08-xchibi-primitive.args: -------------------------------------------------------------------------------- 1 | -xchibi.primitive 2 | -p(+ 2 2) 3 | -------------------------------------------------------------------------------- /tests/run/test08-xchibi-primitive.res: -------------------------------------------------------------------------------- 1 | 4 -------------------------------------------------------------------------------- /tests/run/test09-m.args: -------------------------------------------------------------------------------- 1 | -m 2 | srfi.1 3 | -p 4 | (iota 5) 5 | -------------------------------------------------------------------------------- /tests/run/test09-m.res: -------------------------------------------------------------------------------- 1 | (0 1 2 3 4) -------------------------------------------------------------------------------- /tests/run/test10-xscheme-base-m.args: -------------------------------------------------------------------------------- 1 | -x(scheme base) 2 | -m(srfi 1) 3 | -p(iota 5) 4 | -------------------------------------------------------------------------------- /tests/run/test10-xscheme-base-m.res: -------------------------------------------------------------------------------- 1 | (0 1 2 3 4) -------------------------------------------------------------------------------- /tests/run/test11-xscheme-r5rs-m.args: -------------------------------------------------------------------------------- 1 | -xscheme.r5rs 2 | -m(srfi 1) 3 | -p(iota 5) 4 | -------------------------------------------------------------------------------- /tests/run/test11-xscheme-r5rs-m.res: -------------------------------------------------------------------------------- 1 | (0 1 2 3 4) -------------------------------------------------------------------------------- /tests/run/test12-xchibi-m.args: -------------------------------------------------------------------------------- 1 | -xchibi 2 | -m(srfi 1) 3 | -p(iota 5) 4 | -------------------------------------------------------------------------------- /tests/run/test12-xchibi-m.res: -------------------------------------------------------------------------------- 1 | (0 1 2 3 4) -------------------------------------------------------------------------------- /tests/run/test13-A-m.args: -------------------------------------------------------------------------------- 1 | -Atests/run/lib 2 | -mfact 3 | -p(fact 5) -------------------------------------------------------------------------------- /tests/run/test13-A-m.res: -------------------------------------------------------------------------------- 1 | 120 -------------------------------------------------------------------------------- /tests/run/test14-R.args: -------------------------------------------------------------------------------- 1 | -Atests/run/lib 2 | -Rhello 3 | -------------------------------------------------------------------------------- /tests/run/test14-R.res: -------------------------------------------------------------------------------- 1 | Hello, world! -------------------------------------------------------------------------------- /tests/run/test15-R-args.args: -------------------------------------------------------------------------------- 1 | -Atests/run/lib 2 | -Rhello 3 | -- 4 | Schemer! -------------------------------------------------------------------------------- /tests/run/test15-R-args.res: -------------------------------------------------------------------------------- 1 | Hello, Schemer! -------------------------------------------------------------------------------- /tests/run/test16-R-r.args: -------------------------------------------------------------------------------- 1 | -Atests/run/lib 2 | -Rhello 3 | -rbye 4 | -------------------------------------------------------------------------------- /tests/run/test16-R-r.res: -------------------------------------------------------------------------------- 1 | Goodbye, world! -------------------------------------------------------------------------------- /tests/run/test17-R-r-args.args: -------------------------------------------------------------------------------- 1 | -Atests/run/lib 2 | -Rhello 3 | -rbye 4 | -- 5 | Schemer! -------------------------------------------------------------------------------- /tests/run/test17-R-r-args.res: -------------------------------------------------------------------------------- 1 | Goodbye, Schemer! -------------------------------------------------------------------------------- /tests/run/test18-t.args: -------------------------------------------------------------------------------- 1 | -msrfi.1 2 | -tsrfi.1.append-reverse 3 | -p(append-reverse (quote(3 2 1)) (quote(4 5))) 4 | -------------------------------------------------------------------------------- /tests/run/test18-t.err-res: -------------------------------------------------------------------------------- 1 | > (append-reverse (3 2 1) (4 5)) 2 | | > (append-reverse (2 1) (3 4 5)) 3 | | | > (append-reverse (1) (2 3 4 5)) 4 | | | | > (append-reverse () (1 2 3 4 5)) 5 | | | | (1 2 3 4 5) 6 | | | (1 2 3 4 5) 7 | | (1 2 3 4 5) 8 | (1 2 3 4 5) 9 | -------------------------------------------------------------------------------- /tests/run/test18-t.res: -------------------------------------------------------------------------------- 1 | (1 2 3 4 5) 2 | -------------------------------------------------------------------------------- /tests/run/test19-l.args: -------------------------------------------------------------------------------- 1 | -Atests/run/lib 2 | -lfib.scm 3 | -p(fib 5) -------------------------------------------------------------------------------- /tests/run/test19-l.res: -------------------------------------------------------------------------------- 1 | 8 -------------------------------------------------------------------------------- /tests/snow/repo0/edouard/lucas.sld: -------------------------------------------------------------------------------- 1 | (define-library (edouard lucas) 2 | (export lucas) 3 | (import (scheme base)) 4 | (begin 5 | (define (lucas n) 6 | (if (< n 2) 7 | (if (= n 1) 1 2) 8 | (+ (lucas (- n 1)) (lucas (- n 2))))))) 9 | -------------------------------------------------------------------------------- /tests/snow/repo1/leonardo/fibonacci-test.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base) (scheme process-context) (leonardo fibonacci)) 2 | 3 | (define (test expect expr) 4 | (cond 5 | ((not (equal? expect expr)) 6 | (write-string "FAIL\n") 7 | (exit #f)))) 8 | 9 | (test 1 (fib 0)) 10 | (test 1 (fib 1)) 11 | (test 2 (fib 2)) 12 | (test 3 (fib 3)) 13 | (test 5 (fib 4)) 14 | (test 8 (fib 5)) 15 | (test 13 (fib 6)) 16 | -------------------------------------------------------------------------------- /tests/snow/repo1/leonardo/fibonacci.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (if (< n 2) 3 | 1 4 | (+ (fib (- n 1)) (fib (- n 2))))) 5 | -------------------------------------------------------------------------------- /tests/snow/repo1/leonardo/fibonacci.sld: -------------------------------------------------------------------------------- 1 | (define-library (leonardo fibonacci) 2 | (export fib) 3 | (import (scheme base)) 4 | (include "fibonacci.scm")) 5 | -------------------------------------------------------------------------------- /tests/snow/repo2/leonardo/fibonacci-test.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base) (scheme process-context) (leonardo fibonacci)) 2 | 3 | (define (test expect expr) 4 | (cond 5 | ((not (equal? expect expr)) 6 | (write-string "FAIL\n") 7 | (exit #f)))) 8 | 9 | (test 1 (fib 0)) 10 | (test 1 (fib 1)) 11 | (test 2 (fib 2)) 12 | (test 3 (fib 3)) 13 | (test 5 (fib 4)) 14 | (test 8 (fib 5)) 15 | (test 13 (fib 6)) 16 | -------------------------------------------------------------------------------- /tests/snow/repo2/leonardo/fibonacci.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (let lp ((n n) (a 1) (b 1)) 3 | (if (< n 2) 4 | a 5 | (lp (- n 1) (+ a b) a)))) 6 | -------------------------------------------------------------------------------- /tests/snow/repo2/leonardo/fibonacci.sld: -------------------------------------------------------------------------------- 1 | (define-library (leonardo fibonacci) 2 | (export fib) 3 | (import (scheme base)) 4 | (include "fibonacci.scm")) 5 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/binomial-impl.scm: -------------------------------------------------------------------------------- 1 | (define (binomial n k) 2 | (/ (factorial n) 3 | (* (factorial k) 4 | (factorial (- n k))))) 5 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/binomial-test.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base) (pingala binomial) (pingala test-map)) 2 | 3 | (test-map (1 4 6 4 1) 4 | (lambda (k) (binomial 4 k)) 5 | (0 1 2 3 4)) 6 | (test-map (1 5 10 10 5 1) 7 | (lambda (k) (binomial 5 k)) 8 | (0 1 2 3 4 5)) 9 | 10 | (test-exit) 11 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/binomial.scm: -------------------------------------------------------------------------------- 1 | (define-library (pingala binomial) 2 | (export binomial) 3 | (import (scheme base) (pingala factorial)) 4 | (include "binomial-impl.scm")) 5 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/factorial.scm: -------------------------------------------------------------------------------- 1 | (define-library (pingala factorial) 2 | (export factorial) 3 | (import (scheme base)) 4 | (begin 5 | (define (factorial n) 6 | (let lp ((n n) (res 1)) 7 | (if (<= n 1) res (lp (- n 1) (* res n))))))) 8 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/ganas.txt: -------------------------------------------------------------------------------- 1 | ma 2 | ya 3 | ra 4 | sa 5 | ta 6 | ja 7 | bha 8 | na 9 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/prosody-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (pingala prosody-test) 2 | (export run-tests) 3 | (import (scheme base) (scheme write) (scheme process-context) 4 | (pingala prosody)) 5 | (begin 6 | ;; test utils 7 | (define failed? #f) 8 | (define (fail expr expected res) 9 | (set! failed? #t) 10 | (display "FAIL: ") 11 | (write expr) 12 | (display ": expected: ") 13 | (write expected) 14 | (display " but got: ") 15 | (write res) 16 | (newline)) 17 | (define (test-exit) (exit (not failed?))) 18 | (define-syntax test 19 | (syntax-rules () 20 | ((test expected expr) 21 | (let ((res expr)) 22 | (if (not (equal? res expected)) 23 | (fail 'expr expected res)))))) 24 | ;; tests 25 | (define (run-tests) 26 | (test "ma" (ganas 0)) 27 | (test "bha" (ganas 6)) 28 | (test "L-L-H" (ganas-pattern "sa")) 29 | (test "L-L-H" (ganas-pattern 3)) 30 | (test "H-L-L" (ganas-pattern "bha")) 31 | (test-exit)))) 32 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/test-map.scm: -------------------------------------------------------------------------------- 1 | (define-library (pingala test-map) 2 | (export test-map test-exit) 3 | (import (scheme base) (scheme write) (scheme process-context)) 4 | (begin 5 | (define failed? #f) 6 | (define (fail expected res) 7 | (set! failed? #t) 8 | (display "FAIL: expected ") 9 | (write expected) 10 | (display " but got ") 11 | (write res) 12 | (newline)) 13 | (define (test-exit) (exit (if failed? 1 0))) 14 | (define-syntax test-map 15 | (syntax-rules () 16 | ((test-map expected proc values) 17 | (let ((res (map proc 'values))) 18 | (if (not (equal? res 'expected)) 19 | (fail 'expected res)))))))) 20 | -------------------------------------------------------------------------------- /tests/snow/repo3/pingala/triangle.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base) 2 | (scheme write) 3 | (scheme process-context) 4 | (pingala binomial)) 5 | 6 | (let* ((args (command-line)) 7 | (rows (or (and (pair? args) (pair? (cdr args)) 8 | (string->number (cadr args))) 9 | 5))) 10 | (do ((i 0 (+ i 1))) 11 | ((> i rows)) 12 | (do ((j 0 (+ j 1))) 13 | ((> j i) (newline)) 14 | (if (not (zero? j)) 15 | (write-char #\space)) 16 | (write (binomial i j))))) 17 | -------------------------------------------------------------------------------- /tests/snow/repo3/pythagoras/hyp.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | double hypotenuse(double a, double b) { 4 | return sqrt(a*a + b*b); 5 | } 6 | -------------------------------------------------------------------------------- /tests/snow/repo3/pythagoras/hypotenuse-test.sch: -------------------------------------------------------------------------------- 1 | (import (scheme base) (scheme process-context) (pythagoras hypotenuse)) 2 | 3 | (define (test expect expr) 4 | (cond 5 | ((not (equal? expect expr)) 6 | (write-string "FAIL\n") 7 | (exit #f)))) 8 | 9 | (test 5.0 (hypotenuse 3.0 4.0)) 10 | (test 13.0 (hypotenuse 5.0 12.0)) 11 | (test 25.0 (hypotenuse 7.0 24.0)) 12 | (test 17.0 (hypotenuse 8.0 15.0)) 13 | (test 41.0 (hypotenuse 9.0 40.0)) 14 | (test 61.0 (hypotenuse 11.0 60.0)) 15 | -------------------------------------------------------------------------------- /tests/snow/repo3/pythagoras/hypotenuse.sch: -------------------------------------------------------------------------------- 1 | ;;> Utility to determine the length of the hypotenuse of a right 2 | ;;> triangle given the other two sides. 3 | 4 | (define-library (pythagoras hypotenuse) 5 | (export hypotenuse) 6 | (include-shared "hypotenuse")) 7 | -------------------------------------------------------------------------------- /tests/snow/repo3/pythagoras/hypotenuse.stub: -------------------------------------------------------------------------------- 1 | (c-include-verbatim "hyp.c") 2 | 3 | (define-c double hypotenuse (double double)) 4 | -------------------------------------------------------------------------------- /tests/snow/repo3/recorde/equal-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (recorde equal-test) 2 | (export run-tests test-exit) 3 | (import (except (scheme base) =) 4 | (scheme inexact) 5 | (scheme process-context) 6 | (scheme write) 7 | (recorde equal)) 8 | (begin 9 | (define failed? #f) 10 | (define (set-failed!) 11 | (set! failed? #t)) 12 | (define-syntax test 13 | (syntax-rules () 14 | ((test expr) 15 | (let ((res expr)) 16 | (unless res 17 | (display "test failed: ") 18 | (write 'expr) 19 | (newline) 20 | (set-failed!)))))) 21 | (define (test-exit) 22 | (when failed? 23 | (display "ERROR: tests failed\n") 24 | (exit #f))) 25 | (define (run-tests) 26 | ;; Assuming Recorde was using a platform with a very approximate 27 | ;; acos, the following test may have passed for him, though it 28 | ;; should fail in all of our test implementations. 29 | (test (= 3 (acos -1))) 30 | (test-exit)))) 31 | -------------------------------------------------------------------------------- /tests/snow/repo3/recorde/equal.sld: -------------------------------------------------------------------------------- 1 | ;;> Robert Recorde was a Welsch physician and mathematician, and 2 | ;;> inventor of the "equals" sign (=). 3 | 4 | (define-library (recorde equal) 5 | (export =) 6 | (import (except (scheme base) =)) 7 | (begin 8 | (define epsilon 0.001) 9 | (define (= a b) 10 | (<= (abs (- a b)) (* (abs (max a b)) epsilon))))) 11 | -------------------------------------------------------------------------------- /tests/snow/repo3/takakazu/bernoulli-includes.sld: -------------------------------------------------------------------------------- 1 | (import (scheme base) (pingala binomial)) 2 | (include "bernoulli.scm") 3 | -------------------------------------------------------------------------------- /tests/snow/repo3/takakazu/bernoulli-test.scm: -------------------------------------------------------------------------------- 1 | (import (scheme base) (takakazu bernoulli) (pingala test-map)) 2 | 3 | (test-map (1 -1/2 1/6 0 -1/30 0 1/42 0 -1/30 0 5/66) 4 | (lambda (m) (bernoulli m)) 5 | (0 1 2 3 4 5 6 7 8 9 10)) 6 | 7 | (test-exit) 8 | -------------------------------------------------------------------------------- /tests/snow/repo3/takakazu/bernoulli.scm: -------------------------------------------------------------------------------- 1 | ;; first bernoulli numbers 2 | (define (bernoulli m) 3 | (do ((k 0 (+ k 1)) 4 | (sum 0 (do ((v 0 (+ v 1)) 5 | (sum sum (+ sum 6 | (* (expt -1 v) 7 | (binomial k v) 8 | (/ (expt v m) (+ k 1)))))) 9 | ((> v k) sum)))) 10 | ((> k m) sum))) 11 | -------------------------------------------------------------------------------- /tests/snow/repo3/takakazu/bernoulli.sld: -------------------------------------------------------------------------------- 1 | (define-library (takakazu bernoulli) 2 | (export bernoulli) 3 | (include-library-declarations "bernoulli-includes.sld")) 4 | -------------------------------------------------------------------------------- /tests/snow/repo3/totient-impl.scm: -------------------------------------------------------------------------------- 1 | (define (totient n) 2 | (let ((limit (exact (ceiling (sqrt n))))) 3 | (let lp ((i 2) (count 1)) 4 | (cond ((> i limit) 5 | (if (= count (- i 1)) 6 | (- n 1) ; shortcut for prime 7 | (let lp ((i i) (count count)) 8 | (cond ((>= i n) count) 9 | ((= 1 (gcd n i)) (lp (+ i 1) (+ count 1))) 10 | (else (lp (+ i 1) count)))))) 11 | ((= 1 (gcd n i)) (lp (+ i 1) (+ count 1))) 12 | (else (lp (+ i 1) count)))))) 13 | -------------------------------------------------------------------------------- /tests/snow/repo3/totient-test.scm: -------------------------------------------------------------------------------- 1 | 2 | (import (scheme base) (scheme write) (scheme process-context) (euler totient)) 3 | 4 | (define-syntax test 5 | (syntax-rules () 6 | ((test expect expr) 7 | (let ((res expr)) 8 | (unless (equal? expect res) 9 | (display "FAIL: ") 10 | (write 'expr) 11 | (display " - expected ") 12 | (write expect) 13 | (display " but got ") 14 | (write res) 15 | (newline) 16 | (exit 1)))))) 17 | 18 | (test 1 (totient 2)) 19 | (test 2 (totient 3)) 20 | (test 2 (totient 4)) 21 | (test 4 (totient 5)) 22 | (test 2 (totient 6)) 23 | (test 6 (totient 7)) 24 | (test 4 (totient 8)) 25 | (test 6 (totient 9)) 26 | (test 4 (totient 10)) 27 | -------------------------------------------------------------------------------- /tests/snow/repo3/totient.scm: -------------------------------------------------------------------------------- 1 | (define-library (euler totient) 2 | (export totient) 3 | (import (scheme base) (scheme inexact)) 4 | (include "totient-impl.scm")) 5 | -------------------------------------------------------------------------------- /tests/snow/repo4/VERSION: -------------------------------------------------------------------------------- 1 | 2.3 -------------------------------------------------------------------------------- /tests/snow/repo4/config.scm: -------------------------------------------------------------------------------- 1 | ((command 2 | (package 3 | (author "Leonhard Euler") 4 | (doc-from-scribble #t) 5 | (version-file "tests/snow/repo4/VERSION") 6 | (test-library (append-to-last -test)) 7 | (license bsd)))) 8 | -------------------------------------------------------------------------------- /tests/snow/repo4/euler/exponential-include.sld: -------------------------------------------------------------------------------- 1 | ;;> Library for computing the natural exponential function. 2 | 3 | (include "exponential.scm") 4 | -------------------------------------------------------------------------------- /tests/snow/repo4/euler/exponential-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (euler exponential-test) 2 | (export run-tests) 3 | (import (scheme base) (scheme process-context) (euler exponential)) 4 | (begin 5 | (define (test expect expr) 6 | (cond 7 | ((not (or (equal? expect expr) 8 | (and (or (inexact? expect) (inexact? expr)) 9 | (let ((a (min expect expr)) 10 | (b (max expect expr))) 11 | (< (abs (/ (- a b) b)) 0.000001))))) 12 | (write-string "FAIL\n") 13 | (exit 1)))) 14 | (define (run-tests) 15 | (test 0.36788 (e -1.0)) 16 | (test 1.0 (e 0.0)) 17 | (test 2.71828 (e 1.0)) 18 | (test 4.48167 (e 1.5)) 19 | (test 7.38871 (e 2.0))))) 20 | -------------------------------------------------------------------------------- /tests/snow/repo4/euler/exponential.scm: -------------------------------------------------------------------------------- 1 | 2 | ;;> Returns e^\var{x}. 3 | 4 | (define e 5 | (let ((iterations 10)) 6 | (lambda (x) 7 | (let lp ((i 1) (num 1) (den 1) (res 0)) 8 | (if (> i iterations) 9 | res 10 | (lp (+ i 1) (* num x) (* den i) (+ res (/ num den)))))))) 11 | -------------------------------------------------------------------------------- /tests/snow/repo4/euler/exponential.sld: -------------------------------------------------------------------------------- 1 | 2 | (define-library (euler exponential) 3 | (export e) 4 | (import (scheme base) (scheme inexact)) 5 | (include-library-declarations "exponential-include.sld")) 6 | -------------------------------------------------------------------------------- /tests/snow/repo4/euler/interest-test.sld: -------------------------------------------------------------------------------- 1 | (define-library (euler interest-test) 2 | (export run-tests) 3 | (import (scheme base) (scheme process-context) (euler interest)) 4 | (begin 5 | (define (test expect expr) 6 | (cond 7 | ((not (or (equal? expect expr) 8 | (and (or (inexact? expect) (inexact? expr)) 9 | (let ((a (min expect expr)) 10 | (b (max expect expr))) 11 | (< (abs (/ (- a b) b)) 0.000001))))) 12 | (write-string "FAIL\n") 13 | (exit 1)))) 14 | (define (run-tests) 15 | (test 2.0 (compound-interest 1 1.0 1 1)) 16 | (test 2.25 (compound-interest 1 1.0 1 2)) 17 | (test 2.4414 (compound-interest 1 1.0 1 4)) 18 | (test 2.71828 (compound-interest 1 1.0 1))))) 19 | -------------------------------------------------------------------------------- /tests/snow/repo4/euler/interest.sld: -------------------------------------------------------------------------------- 1 | 2 | ;;> Library for computing (optionally continuously) compounded interest. 3 | 4 | (define-library (euler interest) 5 | (export compound-interest) 6 | (import (scheme base) (scheme inexact)) 7 | (begin 8 | ;;> Returns the total amount starting at \var{base} increasing at 9 | ;;> the given interest rate \var{rate}, for the given \var{duration}. 10 | ;;> Compounds at optional \var{interval} intervals, which default 11 | ;;> to +inf.0 for continuous. 12 | (define (compound-interest base rate duration . o) 13 | (let ((interval (or (and (pair? o) (car o)) +inf.0))) 14 | (if (finite? interval) 15 | (* base (expt (+ 1 (/ rate interval)) (* duration interval))) 16 | (* base (exp (* rate duration)))))))) 17 | -------------------------------------------------------------------------------- /tests/snow/repo5/repo.scm: -------------------------------------------------------------------------------- 1 | ;; forwarding repository with only siblings 2 | (repository 3 | (sibling 4 | (url "../repo3/repo.scm")) 5 | (sibling 6 | (url "../repo4/repo.scm"))) 7 | -------------------------------------------------------------------------------- /tools/chibi-gdb: -------------------------------------------------------------------------------- 1 | LD_LIBRARY_PATH=.: DYLD_LIBRARY_PATH=.: CHIBI_MODULE_PATH=lib gdb --args ./chibi-scheme "$@" 2 | -------------------------------------------------------------------------------- /tools/chibi-run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | DIR="$(dirname "$0")/.." 3 | LD_LIBRARY_PATH="$DIR": DYLD_LIBRARY_PATH="$DIR": CHIBI_MODULE_PATH="$DIR"/lib "$DIR"/chibi-scheme "$@" 4 | -------------------------------------------------------------------------------- /tools/chibi-save: -------------------------------------------------------------------------------- 1 | LD_LIBRARY_PATH=.: DYLD_LIBRARY_PATH=.: CHIBI_MODULE_PATH=lib ./chibi-scheme -m "chibi" -m "(srfi 1)" -m "(srfi 11)" -m "(srfi 16)" -m "(srfi 18)" -m "(srfi 2)" -m "(srfi 26)" -m "(srfi 27)" -m "(srfi 33)" -m "(srfi 38)" -m "(srfi 39)" -m "(srfi 46)" -m "(srfi 55)" -m "(srfi 6)" -m "(srfi 69)" -m "(srfi 8)" -m "(srfi 9)" -m "(srfi 95)" -m "(srfi 98)" -m "(srfi 99)" -d chibi.img 2 | -------------------------------------------------------------------------------- /tools/snow-chibi: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | CHIBI=${CHIBI:-chibi-scheme} 4 | IMG=-isnow.img 5 | if [ -x ./chibi-scheme ] && ! type $CHIBI >/dev/null 2>/dev/null; then 6 | # convenience for running from dev, notable "make test-snow" 7 | CHIBI="./chibi-scheme" 8 | export LD_LIBRARY_PATH=".:${LD_LIBRARY_PATH}" 9 | export DYLD_LIBRARY_PATH=".:${DYLD_LIBRARY_PATH}" 10 | fi 11 | if [ "x$1" = "x--noimage" ]; then 12 | shift 13 | IMG="" 14 | elif ! $CHIBI $IMG -e1 >/dev/null 2>/dev/null; then 15 | IMG="" 16 | fi 17 | SCRIPT_DIR=$(dirname $0) 18 | SNOW_SCRIPT=${SNOW_SCRIPT:-$SCRIPT_DIR/snow-chibi.scm} 19 | 20 | exec "${CHIBI}" $IMG "${SNOW_SCRIPT}" "$@" 21 | --------------------------------------------------------------------------------