>From a9934d7e09b9619f3bfef0e3aa0a5252c07e26b5 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Wed, 28 Jan 2015 19:35:20 +1300 Subject: [PATCH] Convert (some) core units to modules --- README | 28 +-- batch-driver.scm | 5 +- build-version.scm | 10 +- c-backend.scm | 6 +- c-platform.scm | 3 +- chicken-bug.scm | 10 +- chicken-ffi-syntax.scm | 3 + chicken-install.scm | 32 +-- chicken-profile.scm | 6 +- chicken-status.scm | 14 +- chicken-uninstall.scm | 11 +- chicken.foreign.import.scm | 30 +++ chicken.scm | 6 +- common-declarations.scm | 3 +- compiler-syntax.scm | 5 +- core.scm | 9 +- csc.scm | 6 +- csi.scm | 6 +- data-structures.import.scm | 72 ------- data-structures.scm | 21 +- defaults.make | 14 +- distribution/manifest | 41 ++-- eval.scm | 8 +- extras.import.scm | 48 ----- extras.scm | 11 +- files.import.scm | 48 ----- files.scm | 20 +- foreign.import.scm | 30 --- irregex-core.scm | 83 ++++---- irregex.import.scm | 73 ------- irregex.scm | 71 ++----- lolevel.import.scm | 91 --------- lolevel.scm | 30 ++- modules.scm | 10 + optimizer.scm | 3 +- ports.import.scm | 44 ---- ports.scm | 22 ++ posix-common.scm | 13 +- posix.import.scm | 248 ----------------------- posixunix.scm | 75 ++++++- posixwin.scm | 75 ++++++- rules.make | 191 +++++++++++++++--- scripts/makedist.scm | 2 +- scrutinizer.scm | 8 +- setup-api.scm | 13 +- setup-download.scm | 14 +- srfi-4.scm | 12 +- support.scm | 9 +- tcp.import.scm | 44 ---- tcp.scm | 15 +- tests/compiler-tests.scm | 1 + tests/loopy-test.scm | 2 + tests/port-tests.scm | 2 +- tests/pp-test.scm | 2 + tests/r7rs-tests.scm | 2 + tests/reader-tests.scm | 4 +- tests/runtests.bat | 2 +- tests/runtests.sh | 18 +- tests/scrutiny-tests.scm | 2 +- tests/scrutiny.expected | 2 +- tests/srfi-45-tests.scm | 3 +- tests/syntax-tests.scm | 2 +- tests/test-irregex.scm | 2 +- tests/test.scm | 1 + tests/version-tests.scm | 2 +- types.db | 485 ++++++++++++++++++++++----------------------- utils.import.scm | 35 ---- utils.scm | 20 +- 68 files changed, 996 insertions(+), 1243 deletions(-) create mode 100644 chicken.foreign.import.scm delete mode 100644 data-structures.import.scm delete mode 100644 extras.import.scm delete mode 100644 files.import.scm delete mode 100644 foreign.import.scm delete mode 100644 irregex.import.scm delete mode 100644 lolevel.import.scm delete mode 100644 ports.import.scm delete mode 100644 posix.import.scm delete mode 100644 tcp.import.scm delete mode 100644 utils.import.scm diff --git a/README b/README index 3bbb06b..b84b4ac 100644 --- a/README +++ b/README @@ -282,32 +282,32 @@ | `-- chicken.h |-- lib | |-- chicken - | | `-- 6 + | | `-- 7 | | |-- chicken.import.so + | | |-- chicken.data-structures.import.so + | | |-- chicken.extras.import.so + | | |-- chicken.files.import.so + | | |-- chicken.foreign.import.so + | | |-- chicken.lolevel.import.so + | | |-- chicken.irregex.import.so + | | |-- chicken.ports.import.so + | | |-- chicken.posix.import.so + | | |-- chicken.tcp.import.so + | | |-- chicken.utils.import.so | | |-- csi.import.so - | | |-- data-structures.import.so - | | |-- extras.import.so - | | |-- files.import.so - | | |-- foreign.import.so - | | |-- irregex.import.so - | | |-- lolevel.import.so | | |-- modules.db - | | |-- ports.import.so - | | |-- posix.import.so | | |-- setup-api.import.so | | |-- setup-api.so | | |-- setup-download.import.so | | |-- setup-download.so | | |-- srfi-1.import.so | | |-- srfi-4.import.so - | | |-- tcp.import.so - | | |-- types.db - | | `-- utils.import.so + | | `-- types.db | |-- libchicken.a | |-- libchicken.dll.a (Windows) | |-- libchicken.dylib (Macintosh) - | |-- libchicken.so -> libchicken.so.6 (Unix) - | `-- libchicken.so.6 (Unix) + | |-- libchicken.so -> libchicken.so.7 (Unix) + | `-- libchicken.so.7 (Unix) `-- share |-- chicken | |-- doc diff --git a/batch-driver.scm b/batch-driver.scm index f28d0ae..0027c08 100644 --- a/batch-driver.scm +++ b/batch-driver.scm @@ -40,7 +40,10 @@ user-options-pass user-read-pass user-preprocessor-pass user-pass user-post-analysis-pass) -(import chicken scheme extras data-structures files srfi-1 +(import chicken scheme srfi-1 + chicken.data-structures + chicken.extras + chicken.files chicken.compiler.support chicken.compiler.compiler-syntax chicken.compiler.core diff --git a/build-version.scm b/build-version.scm index 038e9aa..e180352 100644 --- a/build-version.scm +++ b/build-version.scm @@ -36,10 +36,12 @@ (lambda (x r c) (let ((fn (cadr x))) (and (file-exists? fn) - (let ((ver (with-input-from-file (cadr x) read-line))) - (if (or (eof-object? ver) (string=? ver "")) - #f - ver))))))) + (call-with-input-file (cadr x) + (lambda (p) + (let ((ver ((##sys#slot (##sys#slot p 2) 8) p 256))) ; read-line + (if (or (eof-object? ver) (string=? ver "")) + #f + ver))))))))) (define (##sys#build-tag) (foreign-value "C_BUILD_TAG" c-string)) (define ##sys#build-id (read-version "buildid")) diff --git a/c-backend.scm b/c-backend.scm index ccfca61..cbe27ba 100644 --- a/c-backend.scm +++ b/c-backend.scm @@ -38,10 +38,12 @@ ;; For "foreign" (aka chicken-ffi-syntax): foreign-type-declaration) -(import chicken scheme foreign srfi-1 data-structures +(import chicken scheme srfi-1 + chicken.data-structures chicken.compiler.core chicken.compiler.c-platform - chicken.compiler.support) + chicken.compiler.support + chicken.foreign) ;;; Write atoms to output-port: diff --git a/c-platform.scm b/c-platform.scm index c93947c..76cf8bd 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -42,7 +42,8 @@ target-include-file words-per-flonum parameter-limit small-parameter-limit) -(import chicken scheme srfi-1 data-structures +(import chicken scheme srfi-1 + chicken.data-structures chicken.compiler.optimizer chicken.compiler.support chicken.compiler.core) diff --git a/chicken-bug.scm b/chicken-bug.scm index ef2bd2b..a4bc371 100644 --- a/chicken-bug.scm +++ b/chicken-bug.scm @@ -24,8 +24,14 @@ ; POSSIBILITY OF SUCH DAMAGE. -(require-extension posix tcp data-structures utils extras) - +(require-library posix tcp data-structures utils extras) + +(import chicken.data-structures + chicken.extras + chicken.foreign + chicken.posix + chicken.tcp + chicken.utils) (define-constant +bug-report-file+ "chicken-bug-report.~a-~a-~a") diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm index d3fc79b..f546477 100644 --- a/chicken-ffi-syntax.scm +++ b/chicken-ffi-syntax.scm @@ -27,6 +27,7 @@ (declare (unit chicken-ffi-syntax) + (uses data-structures) (disable-interrupts) (fixnum)) @@ -38,6 +39,8 @@ (no-bound-checks) (no-procedure-checks)) +(import chicken.data-structures) + (##sys#provide 'chicken-ffi-syntax) diff --git a/chicken-install.scm b/chicken-install.scm index 5b5140d..d7d871a 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -29,30 +29,36 @@ (module main () - (import scheme chicken srfi-1 posix data-structures utils irregex ports extras - files) + (import scheme chicken srfi-1) (import setup-download setup-api) - (import foreign) + (import chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.irregex + chicken.ports + chicken.posix + chicken.utils) (define +default-repository-files+ ;;XXX keep this up-to-date! '("setup-api.so" "setup-api.import.so" "setup-download.so" "setup-download.import.so" "chicken.import.so" - "lolevel.import.so" + "chicken.data-structures.import.so" + "chicken.extras.import.so" + "chicken.files.import.so" + "chicken.foreign.import.so" + "chicken.irregex.import.so" + "chicken.lolevel.import.so" + "chicken.ports.import.so" + "chicken.posix.import.so" + "chicken.tcp.import.so" + "chicken.utils.import.so" "srfi-1.import.so" "srfi-4.import.so" - "data-structures.import.so" - "ports.import.so" - "files.import.so" - "posix.import.so" - "extras.import.so" - "tcp.import.so" - "foreign.import.so" - "utils.import.so" "csi.import.so" - "irregex.import.so" "types.db")) (define-constant +defaults-version+ 1) diff --git a/chicken-profile.scm b/chicken-profile.scm index e845e68..72936eb 100644 --- a/chicken-profile.scm +++ b/chicken-profile.scm @@ -29,8 +29,10 @@ (block) (uses srfi-1 data-structures - posix - utils)) + posix)) + +(import chicken.data-structures + chicken.posix) (define symbol-table-size 3001) diff --git a/chicken-status.scm b/chicken-status.scm index b0b0f0c..1e3a132 100644 --- a/chicken-status.scm +++ b/chicken-status.scm @@ -24,14 +24,20 @@ ; POSSIBILITY OF SUCH DAMAGE. -(require-library setup-api srfi-1 posix data-structures utils ports irregex files) +(require-library setup-api srfi-1 posix data-structures ports irregex files) (module main () - (import scheme chicken foreign) - (import srfi-1 posix data-structures utils ports irregex - files setup-api extras) + (import scheme chicken) + (import srfi-1 setup-api) + (import chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.irregex + chicken.ports + chicken.posix) (define-foreign-variable C_TARGET_LIB_HOME c-string) (define-foreign-variable C_BINARY_VERSION int) diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm index b008e93..a6b3176 100644 --- a/chicken-uninstall.scm +++ b/chicken-uninstall.scm @@ -31,9 +31,16 @@ (module main () - (import scheme chicken foreign) + (import scheme chicken) (import setup-api) - (import srfi-1 posix data-structures utils ports irregex files) + (import srfi-1) + (import chicken.data-structures + chicken.files + chicken.foreign + chicken.irregex + chicken.ports + chicken.posix + chicken.utils) (define-foreign-variable C_TARGET_LIB_HOME c-string) (define-foreign-variable C_BINARY_VERSION int) diff --git a/chicken.foreign.import.scm b/chicken.foreign.import.scm new file mode 100644 index 0000000..e717ca8 --- /dev/null +++ b/chicken.foreign.import.scm @@ -0,0 +1,30 @@ +;;;; chicken.foreign.import.scm - import library for "foreign" pseudo module +; +; Copyright (c) 2008-2014, The CHICKEN Team +; All rights reserved. +; +; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following +; conditions are met: +; +; Redistributions of source code must retain the above copyright notice, this list of conditions and the following +; disclaimer. +; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following +; disclaimer in the documentation and/or other materials provided with the distribution. +; Neither the name of the author nor the names of its contributors may be used to endorse or promote +; products derived from this software without specific prior written permission. +; +; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS +; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY +; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR +; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +; POSSIBILITY OF SUCH DAMAGE. + + +(##sys#register-primitive-module + 'chicken.foreign + '() + ##sys#chicken-ffi-macro-environment) diff --git a/chicken.scm b/chicken.scm index f0dfa8e..9a32f6d 100644 --- a/chicken.scm +++ b/chicken.scm @@ -27,7 +27,7 @@ (declare (uses chicken-syntax chicken-ffi-syntax - srfi-1 srfi-4 utils files extras data-structures support + srfi-1 srfi-4 utils extras data-structures support compiler optimizer lfa2 compiler-syntax scrutinizer ;; TODO: These three need to be made configurable somehow batch-driver c-platform c-backend)) @@ -35,7 +35,9 @@ (include "tweaks") (import chicken.compiler.batch-driver - chicken.compiler.c-platform) + chicken.compiler.c-platform + chicken.data-structures + chicken.utils) ;;; Prefix argument list with default options: diff --git a/common-declarations.scm b/common-declarations.scm index b20e3b1..3fb05c2 100644 --- a/common-declarations.scm +++ b/common-declarations.scm @@ -32,7 +32,8 @@ (define-syntax d (syntax-rules () ((_ arg1) - (when (##sys#fudge 13) (pp arg1))) ; debug-mode + (when (##sys#fudge 13) ; debug-mode + (chicken.extras#pp arg1))) ((_ arg1 more ...) (when (##sys#fudge 13) (print arg1 more ...)))))) diff --git a/compiler-syntax.scm b/compiler-syntax.scm index 0070782..1f3557b 100644 --- a/compiler-syntax.scm +++ b/compiler-syntax.scm @@ -32,9 +32,10 @@ (module chicken.compiler.compiler-syntax (compiler-syntax-statistics) -(import chicken scheme srfi-1 data-structures +(import chicken scheme srfi-1 chicken.compiler.support - chicken.compiler.core) + chicken.compiler.core + chicken.data-structures) (include "tweaks.scm") diff --git a/core.scm b/core.scm index 56310cc..a159d5a 100644 --- a/core.scm +++ b/core.scm @@ -314,9 +314,12 @@ constant-table immutable-constants inline-table line-number-database-2 line-number-database-size) -(import chicken scheme foreign srfi-1 extras data-structures +(import chicken scheme srfi-1 chicken.compiler.scrutinizer - chicken.compiler.support) + chicken.compiler.support + chicken.data-structures + chicken.extras + chicken.foreign) (define (d arg1 . more) (when (##sys#fudge 13) ; debug mode? @@ -2891,4 +2894,4 @@ (debugging 'o "fast global assignments" fastsets)) (values node2 (##sys#fast-reverse literals) (##sys#fast-reverse lambda-info-literals) lambda-table) ) ) ) -) \ No newline at end of file +) diff --git a/csc.scm b/csc.scm index d38cc27..a12bd03 100644 --- a/csc.scm +++ b/csc.scm @@ -27,7 +27,11 @@ (declare (block) - (uses data-structures ports srfi-1 utils files extras)) + (uses data-structures srfi-1 utils files extras)) + +(import chicken.data-structures + chicken.files + chicken.utils) (define-foreign-variable INSTALL_BIN_HOME c-string "C_INSTALL_BIN_HOME") (define-foreign-variable INSTALL_CC c-string "C_INSTALL_CC") diff --git a/csi.scm b/csi.scm index 4bd0469..5e95e67 100644 --- a/csi.scm +++ b/csi.scm @@ -26,7 +26,7 @@ (declare - (uses ports extras) + (uses data-structures ports extras) (usual-integrations) (disable-interrupts) (compile-syntax) @@ -54,6 +54,10 @@ EOF describe dump tty-input? history-list history-count history-add history-ref history-clear history-show) ) +(import chicken.data-structures + chicken.extras + chicken.ports) + ;;; Parameters: diff --git a/data-structures.import.scm b/data-structures.import.scm deleted file mode 100644 index 561ffad..0000000 --- a/data-structures.import.scm +++ /dev/null @@ -1,72 +0,0 @@ -;;;; data-structures.import.scm - import library for "data-structures" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'data-structures - '(->string - alist-ref - alist-update! - alist-update - any? - atom? - butlast - chop - complement - compose - compress - conc - conjoin - constantly - disjoin - each - flatten - flip - identity - intersperse - join - list-of? - merge - merge! - o - rassoc - reverse-string-append - sort - sort! - sorted? - topological-sort - string-chomp - string-chop - string-compare3 - string-compare3-ci - string-intersperse - string-split - string-translate - string-translate* - substring-ci=? - substring-index - substring-index-ci - substring=? - tail?)) diff --git a/data-structures.scm b/data-structures.scm index 6c55438..5abb66d 100644 --- a/data-structures.scm +++ b/data-structures.scm @@ -28,6 +28,23 @@ (declare (unit data-structures)) +(module chicken.data-structures + (alist-ref alist-update alist-update! atom? butlast + chop compress flatten intersperse join rassoc tail? + merge sort sorted? topological-sort + conc ->string string-chop string-chomp + string-compare3 string-compare3-ci + reverse-string-append + string-intersperse string-split + string-translate string-translate* + substring=? substring-ci=? + substring-index substring-index-ci + any? constantly complement compose + conjoin disjoin each flip identity list-of? o) + +(import scheme chicken) +(import chicken.foreign) + (include "common-declarations.scm") (register-feature! 'data-structures) @@ -90,7 +107,7 @@ (lambda (lst) (let loop ([lst lst]) (cond [(null? lst) #t] - [(not-pair? lst) #f] + [(not (pair? lst)) #f] [(pred (##sys#slot lst 0)) (loop (##sys#slot lst 1))] [else #f] ) ) ) ) @@ -763,3 +780,5 @@ (cdar dag) '() state))))) + +) diff --git a/defaults.make b/defaults.make index 5ae7864..33c4cf5 100644 --- a/defaults.make +++ b/defaults.make @@ -265,6 +265,14 @@ endif CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile) +# import libraries + +PRIMITIVE_IMPORT_LIBRARIES = chicken srfi-1 srfi-4 +PRIMITIVE_IMPORT_LIBRARIES += csi setup-api setup-download +POSIX_IMPORT_LIBRARY = posix +FOREIGN_IMPORT_LIBRARY = foreign +DYNAMIC_IMPORT_LIBRARIES = data-structures extras files irregex lolevel ports tcp utils + # targets CHICKEN_PROGRAM = $(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX) @@ -275,8 +283,10 @@ CHICKEN_INSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-install$(PROGRAM_SUFFIX) CHICKEN_UNINSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-uninstall$(PROGRAM_SUFFIX) CHICKEN_STATUS_PROGRAM = $(PROGRAM_PREFIX)chicken-status$(PROGRAM_SUFFIX) CHICKEN_BUG_PROGRAM = $(PROGRAM_PREFIX)chicken-bug$(PROGRAM_SUFFIX) -IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix extras tcp foreign utils csi irregex -IMPORT_LIBRARIES += setup-api setup-download +IMPORT_LIBRARIES = $(PRIMITIVE_IMPORT_LIBRARIES) \ + chicken.$(POSIX_IMPORT_LIBRARY) \ + chicken.$(FOREIGN_IMPORT_LIBRARY) \ + $(foreach lib,$(DYNAMIC_IMPORT_LIBRARIES),chicken.$(lib)) ifdef STATICBUILD CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)$(EXE) diff --git a/distribution/manifest b/distribution/manifest index 370e275..2a870f5 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -20,6 +20,7 @@ csc.c csi.c eval.c data-structures.c +chicken.data-structures.import.scm ports.c files.c extras.c @@ -232,32 +233,32 @@ modules.c chicken-syntax.scm chicken-syntax.c common-declarations.scm -ports.import.scm -ports.import.c -files.import.scm -files.import.c chicken.import.scm chicken.import.c -foreign.import.scm -foreign.import.c -lolevel.import.scm +chicken.data-structures.import.scm +chicken.data-structures.import.c +chicken.extras.import.scm +chicken.extras.import.c +chicken.files.import.scm +chicken.files.import.c +chicken.foreign.import.scm +chicken.foreign.import.c +chicken.irregex.import.scm +chicken.irregex.import.c +chicken.lolevel.import.scm +chicken.lolevel.import.c +chicken.ports.import.scm +chicken.ports.import.c +chicken.posix.import.scm +chicken.posix.import.c +chicken.tcp.import.scm +chicken.tcp.import.c +chicken.utils.import.scm +chicken.utils.import.c srfi-1.import.scm srfi-4.import.scm -data-structures.import.scm -posix.import.scm -extras.import.scm -irregex.import.scm -tcp.import.scm -utils.import.scm -lolevel.import.c srfi-1.import.c srfi-4.import.c -data-structures.import.c -posix.import.c -extras.import.c -irregex.import.c -tcp.import.c -utils.import.c csi.import.scm csi.import.c setup-download.scm diff --git a/eval.scm b/eval.scm index c350522..d8f3060 100644 --- a/eval.scm +++ b/eval.scm @@ -1305,10 +1305,10 @@ (##sys#syntax-error-hook 'require-extension "invalid SRFI number" n))) (define (doit id impid) (cond ((or (memq id builtin-features) - (if comp? - (memq id builtin-features/compiled) - (##sys#feature? id) ) ) - (values (impform '(##core#undefined) impid #t) #t id) ) + (and comp? (memq id builtin-features/compiled))) + (values (impform '(##core#undefined) impid #t) #t id)) + ((and (not comp?) (##sys#feature? id)) + (values (impform '(##core#undefined) impid #f) #t id)) ((memq id ##sys#core-library-modules) (values (impform diff --git a/extras.import.scm b/extras.import.scm deleted file mode 100644 index 0ca78c6..0000000 --- a/extras.import.scm +++ /dev/null @@ -1,48 +0,0 @@ -;;;; extras.import.scm - import library for "extras" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'extras - '(format - fprintf - pp - pretty-print - pretty-print-width - printf - random - randomize - read-buffered - read-byte - read-file - read-line - read-lines - read-string - read-string! - read-token - sprintf - write-byte - write-line - write-string)) diff --git a/extras.scm b/extras.scm index 427a49a..67d89be 100644 --- a/extras.scm +++ b/extras.scm @@ -29,8 +29,14 @@ (unit extras) (uses data-structures)) -(declare - (hide fprintf0 generic-write) ) +(module chicken.extras + (format fprintf pp pretty-print pretty-print-width printf + random randomize read-buffered read-byte read-file read-line + read-lines read-string read-string! read-token sprintf + write-byte write-line write-string) + +(import scheme chicken) +(import chicken.data-structures) (include "common-declarations.scm") @@ -653,3 +659,4 @@ (register-feature! 'srfi-28) +) diff --git a/files.import.scm b/files.import.scm deleted file mode 100644 index 44d0e00..0000000 --- a/files.import.scm +++ /dev/null @@ -1,48 +0,0 @@ -;;;; files.import.scm - import library for "files" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'files - '(delete-file* - file-copy - file-move - make-pathname - directory-null? - make-absolute-pathname - create-temporary-directory - create-temporary-file - decompose-directory - decompose-pathname - absolute-pathname? - pathname-directory - pathname-extension - pathname-file - pathname-replace-directory - pathname-replace-extension - pathname-replace-file - pathname-strip-directory - pathname-strip-extension - normalize-pathname)) diff --git a/files.scm b/files.scm index 6b93573..914ea07 100644 --- a/files.scm +++ b/files.scm @@ -36,9 +36,8 @@ (declare (unit files) - (uses irregex data-structures) + (uses data-structures extras irregex) (fixnum) - (hide chop-pds absolute-pathname-root root-origin root-directory split-directory) (disable-interrupts) (foreign-declare #< @@ -52,6 +51,21 @@ EOF )) +(module chicken.files + (delete-file* file-copy file-move make-pathname directory-null? + make-absolute-pathname create-temporary-directory + create-temporary-file decompose-directory decompose-pathname + absolute-pathname? pathname-directory pathname-extension + pathname-file pathname-replace-directory pathname-replace-extension + pathname-replace-file pathname-strip-directory + pathname-strip-extension normalize-pathname) + +(import scheme chicken) +(import chicken.data-structures + chicken.extras + chicken.foreign + chicken.irregex) + (include "common-declarations.scm") (register-feature! 'files) @@ -447,3 +461,5 @@ EOF (rt (absolute-pathname-root dir)) (org (root-origin rt)) ) (values org (root-directory rt) (strip-origin-prefix org (and (not (null? ls)) ls))) ) ) + +) diff --git a/foreign.import.scm b/foreign.import.scm deleted file mode 100644 index bef1635..0000000 --- a/foreign.import.scm +++ /dev/null @@ -1,30 +0,0 @@ -;;;; foreign.import.scm - import library for "foreign" pseudo module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'foreign - '() - ##sys#chicken-ffi-macro-environment) diff --git a/irregex-core.scm b/irregex-core.scm index 9d09a48..c4dbea2 100644 --- a/irregex-core.scm +++ b/irregex-core.scm @@ -93,72 +93,67 @@ (cond-expand (chicken-bootstrap (begin - (define-syntax internal - (er-macro-transformer - (lambda (x r c) - `(,(with-input-from-string (cadr x) read) ,@(cddr x))))) ;; make-irregex defined elsewhere (define (irregex? x) - (internal "##sys#structure?" x 'regexp)) + (##sys#structure? x 'regexp)) (define (irregex-dfa x) - (internal "##sys#check-structure" x 'regexp 'irregex-dfa) - (internal "##sys#slot" x 1)) + (##sys#check-structure x 'regexp 'irregex-dfa) + (##sys#slot x 1)) (define (irregex-dfa/search x) - (internal "##sys#check-structure" x 'regexp 'irregex-dfa/search) - (internal "##sys#slot" x 2)) + (##sys#check-structure x 'regexp 'irregex-dfa/search) + (##sys#slot x 2)) (define (irregex-nfa x) - (internal "##sys#check-structure" x 'regexp 'irregex-nfa) - (internal "##sys#slot" x 3)) + (##sys#check-structure x 'regexp 'irregex-nfa) + (##sys#slot x 3)) (define (irregex-flags x) - (internal "##sys#check-structure" x 'regexp 'irregex-flags) - (internal "##sys#slot" x 4)) + (##sys#check-structure x 'regexp 'irregex-flags) + (##sys#slot x 4)) (define (irregex-num-submatches x) - (internal "##sys#check-structure" x 'regexp 'irregex-num-submatches) - (internal "##sys#slot" x 5)) + (##sys#check-structure x 'regexp 'irregex-num-submatches) + (##sys#slot x 5)) (define (irregex-lengths x) - (internal "##sys#check-structure" x 'regexp 'irregex-lengths) - (internal "##sys#slot" x 6)) + (##sys#check-structure x 'regexp 'irregex-lengths) + (##sys#slot x 6)) (define (irregex-names x) - (internal "##sys#check-structure" x 'regexp 'irregex-names) - (internal "##sys#slot" x 7)) + (##sys#check-structure x 'regexp 'irregex-names) + (##sys#slot x 7)) ;; make-irregex-match defined elsewhere (define (irregex-new-matches irx) (make-irregex-match (irregex-num-submatches irx) (irregex-names irx))) (define (irregex-reset-matches! m) - (let ((v (internal "##sys#slot" m 1))) + (let ((v (##sys#slot m 1))) (vector-fill! v #f) m)) (define (irregex-copy-matches m) - (and (internal "##sys#structure?" m 'regexp-match) - (internal - "##sys#make-structure" + (and (##sys#structure? m 'regexp-match) + (##sys#make-structure 'regexp-match - (vector-copy (internal "##sys#slot" m 1)) - (internal "##sys#slot" m 2) - (internal "##sys#slot" m 3) - (internal "##sys#slot" m 4)))) + (vector-copy (##sys#slot m 1)) + (##sys#slot m 2) + (##sys#slot m 3) + (##sys#slot m 4)))) (define (irregex-match-data? obj) - (internal "##sys#structure?" obj 'regexp-match)) + (##sys#structure? obj 'regexp-match)) (define (irregex-match-num-submatches m) - (internal "##sys#check-structure" m 'regexp-match 'irregex-match-num-submatches) - (- (fx/ (internal "##sys#size" (internal "##sys#slot" m 1)) 4) 2)) + (##sys#check-structure m 'regexp-match 'irregex-match-num-submatches) + (- (fx/ (##sys#size (##sys#slot m 1)) 4) 2)) (define (irregex-match-chunker m) - (internal "##sys#slot" m 3)) + (##sys#slot m 3)) (define (irregex-match-names m) - (internal "##sys#check-structure" m 'regexp-match 'irregex-match-names) - (internal "##sys#slot" m 2)) + (##sys#check-structure m 'regexp-match 'irregex-match-names) + (##sys#slot m 2)) (define (irregex-match-chunker-set! m str) - (internal "##sys#setslot" m 3 str)) + (##sys#setslot m 3 str)) (define-inline (%irregex-match-start-chunk m n) - (internal "##sys#slot" (internal "##sys#slot" m 1) (* n 4))) + (##sys#slot (##sys#slot m 1) (* n 4))) (define-inline (%irregex-match-start-index m n) - (internal "##sys#slot" (internal "##sys#slot" m 1) (+ 1 (* n 4)))) + (##sys#slot (##sys#slot m 1) (+ 1 (* n 4)))) (define-inline (%irregex-match-end-chunk m n) - (internal "##sys#slot" (internal "##sys#slot" m 1) (+ 2 (* n 4)))) + (##sys#slot (##sys#slot m 1) (+ 2 (* n 4)))) (define (%irregex-match-end-index m n) - (internal "##sys#slot" (internal "##sys#slot" m 1) (+ 3 (* n 4)))) - (define (%irregex-match-fail m) (internal "##sys#slot" m 4)) - (define (%irregex-match-fail-set! m x) (internal "##sys#setslot" m 4 x)) + (##sys#slot (##sys#slot m 1) (+ 3 (* n 4)))) + (define (%irregex-match-fail m) (##sys#slot m 4)) + (define (%irregex-match-fail-set! m x) (##sys#setslot m 4 x)) (define-record-printer (regexp-match m out) (let ((n (irregex-match-num-submatches m))) (display "# n 1)) (display "es" out)) (display ")>" out))) (define-inline (irregex-match-valid-numeric-index? m n) - (let ((v (internal "##sys#slot" m 1))) - (and (>= n 0) (< (* n 4) (- (internal "##sys#size" v) 4))))) + (let ((v (##sys#slot m 1))) + (and (>= n 0) (< (* n 4) (- (##sys#size v) 4))))) (define-inline (irregex-match-matched-numeric-index? m n) - (let ((v (internal "##sys#slot" m 1))) - (and (internal "##sys#slot" v (+ 1 (* n 4))) + (let ((v (##sys#slot m 1))) + (and (##sys#slot v (+ 1 (* n 4))) #t))))) (else (begin diff --git a/irregex.import.scm b/irregex.import.scm deleted file mode 100644 index 99b11a2..0000000 --- a/irregex.import.scm +++ /dev/null @@ -1,73 +0,0 @@ -;;;; irregex.import.scm - import library for "regex" module (irregex API) -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'irregex - '(irregex - irregex-apply-match - irregex-dfa - irregex-dfa/extract - irregex-dfa/search - irregex-extract - irregex-flags - irregex-fold - irregex-fold/chunked - irregex-lengths - irregex-match - irregex-match? - irregex-match-data? - irregex-match-end-chunk - irregex-match-end-index - irregex-match-names - irregex-match-num-submatches - irregex-match-start-chunk - irregex-match-start-index - irregex-match-string - irregex-match-subchunk - irregex-match-substring - irregex-match-valid-index? - irregex-match/chunked - irregex-names - irregex-new-matches - irregex-nfa - irregex-num-submatches - irregex-opt - irregex-quote - irregex-replace - irregex-replace/all - irregex-reset-matches! - irregex-search - irregex-search/chunked - irregex-search/matches - irregex-split - irregex? - make-irregex-chunker - maybe-string->sre - sre->irregex - sre->string - string->irregex - string->sre - )) diff --git a/irregex.scm b/irregex.scm index afeb11d..bb81920 100644 --- a/irregex.scm +++ b/irregex.scm @@ -25,58 +25,27 @@ -(declare (unit irregex)) - (declare + (unit irregex) (no-procedure-checks) - (fixnum) - (export - ##sys#glob->regexp - irregex - irregex-apply-match - irregex-dfa - irregex-dfa/extract - irregex-dfa/search - irregex-extract - irregex-flags - irregex-fold - irregex-fold/chunked - irregex-lengths - irregex-match - irregex-match? - irregex-match-data? - irregex-match-end-chunk - irregex-match-end-index - irregex-match-names - irregex-match-num-submatches - irregex-match-start-chunk - irregex-match-start-index - irregex-match-subchunk - irregex-match-substring - irregex-match-valid-index? - irregex-match/chunked - irregex-names - irregex-new-matches - irregex-nfa - irregex-num-submatches - irregex-opt - irregex-quote - irregex-replace - irregex-replace/all - irregex-reset-matches! - irregex-search - irregex-search/chunked - irregex-search/matches - irregex-split - irregex? - make-irregex-chunker - maybe-string->sre - irregex-search/chunked - sre->irregex - sre->string - string->irregex - string->sre - )) + (fixnum)) + +(module chicken.irregex + (irregex irregex-apply-match irregex-dfa irregex-dfa/search + irregex-extract irregex-flags irregex-fold irregex-fold/chunked + irregex-lengths irregex-match irregex-match? irregex-match-data? + irregex-match-end-chunk irregex-match-end-index irregex-match-names + irregex-match-num-submatches irregex-match-start-chunk + irregex-match-start-index irregex-match-subchunk + irregex-match-substring irregex-match-valid-index? + irregex-match/chunked irregex-names irregex-new-matches irregex-nfa + irregex-num-submatches irregex-opt irregex-quote irregex-replace + irregex-replace/all irregex-reset-matches! irregex-search + irregex-search/chunked irregex-search/matches irregex-split irregex? + make-irregex-chunker maybe-string->sre sre->irregex sre->string + string->irregex string->sre) + +(import scheme chicken) (include "common-declarations.scm") @@ -285,3 +254,5 @@ (loop2 (cdr rest) (cons (car rest) s)))))) (else (cons c (loop rest (memq c '(#\\ #\/)))))))))))) (if sre? sre (irregex sre)))))) + +) diff --git a/lolevel.import.scm b/lolevel.import.scm deleted file mode 100644 index 1e6f028..0000000 --- a/lolevel.import.scm +++ /dev/null @@ -1,91 +0,0 @@ -;;;; lolevel.import.scm - import library for "lolevel" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'lolevel - '(address->pointer - align-to-word - allocate - block-ref - block-set! - extend-procedure - extended-procedure? - free - locative->object - locative-ref - locative-set! - locative? - make-locative - make-record-instance - make-pointer-vector - make-weak-locative - move-memory! - mutate-procedure! - null-pointer - number-of-bytes - number-of-slots - object->pointer - object-become! - object-copy - pointer->address - pointer-like? - pointer->object - pointer-f32-ref - pointer-f32-set! - pointer-f64-ref - pointer-f64-set! - pointer+ - pointer-s16-ref - pointer-s16-set! - pointer-s32-ref - pointer-s32-set! - pointer-s8-ref - pointer-s8-set! - pointer-vector - pointer-vector? - pointer-vector-length - pointer-vector-ref - pointer-vector-set! - pointer-tag - pointer-u16-ref - pointer-u16-set! - pointer-u32-ref - pointer-u32-set! - pointer-u8-ref - pointer-u8-set! - pointer=? - pointer? - procedure-data - record->vector - record-instance? - record-instance-length - record-instance-slot - record-instance-slot-set! - record-instance-type - set-procedure-data! - tag-pointer - tagged-pointer? - vector-like?)) diff --git a/lolevel.scm b/lolevel.scm index b638541..af2c4f6 100644 --- a/lolevel.scm +++ b/lolevel.scm @@ -27,13 +27,6 @@ (declare (unit lolevel) - (hide ipc-hook-0 *set-invalid-procedure-call-handler! xproc-tag - ##sys#check-block - ##sys#check-become-alist - ##sys#check-generic-structure - ##sys#check-generic-vector - pv-buf-ref pv-buf-set!) - (not inline ipc-hook-0 ##sys#invalid-procedure-call-hook) (foreign-declare #< @@ -43,6 +36,27 @@ EOF ) ) +(module chicken.lolevel + (address->pointer align-to-word allocate block-ref block-set! + extend-procedure extended-procedure? free locative->object + locative-ref locative-set! locative? make-locative + make-pointer-vector make-record-instance make-weak-locative + move-memory! mutate-procedure! number-of-bytes number-of-slots + object->pointer object-become! object-copy pointer+ pointer->address + pointer->object pointer-f32-ref pointer-f32-set! pointer-f64-ref + pointer-f64-set! pointer-like? pointer-s16-ref pointer-s16-set! + pointer-s32-ref pointer-s32-set! pointer-s8-ref pointer-s8-set! + pointer-tag pointer-u16-ref pointer-u16-set! pointer-u32-ref + pointer-u32-set! pointer-u8-ref pointer-u8-set! pointer-vector + pointer-vector-fill! pointer-vector-length pointer-vector-ref + pointer-vector-set! pointer-vector? pointer=? pointer? procedure-data + record->vector record-instance-length record-instance-slot + record-instance-slot-set! record-instance-type record-instance? + set-procedure-data! tag-pointer tagged-pointer? vector-like?) + +(import scheme chicken) +(import chicken.foreign) + (include "common-declarations.scm") (register-feature! 'lolevel) @@ -556,3 +570,5 @@ EOF (define (pointer-vector-length pv) (##sys#check-structure pv 'pointer-vector 'pointer-vector-length) (##sys#slot pv 1)) + +) diff --git a/modules.scm b/modules.scm index a5055d9..2d1922b 100644 --- a/modules.scm +++ b/modules.scm @@ -910,6 +910,16 @@ (##sys#register-primitive-module 'r5rs-null '() r4rs-syntax)) (##sys#register-module-alias 'r5rs 'scheme) +(##sys#register-module-alias 'data-structures 'chicken.data-structures) +(##sys#register-module-alias 'extras 'chicken.extras) +(##sys#register-module-alias 'files 'chicken.files) +(##sys#register-module-alias 'foreign 'chicken.foreign) +(##sys#register-module-alias 'irregex 'chicken.irregex) +(##sys#register-module-alias 'lolevel 'chicken.lolevel) +(##sys#register-module-alias 'ports 'chicken.ports) +(##sys#register-module-alias 'posix 'chicken.posix) +(##sys#register-module-alias 'tcp 'chicken.tcp) +(##sys#register-module-alias 'utils 'chicken.utils) (register-feature! 'module-environments) diff --git a/optimizer.scm b/optimizer.scm index 4c00c22..790eb1e 100644 --- a/optimizer.scm +++ b/optimizer.scm @@ -36,7 +36,8 @@ eq-inline-operator membership-test-operators membership-unfold-limit default-optimization-passes rewrite) -(import chicken scheme srfi-1 data-structures +(import chicken scheme srfi-1 + chicken.data-structures chicken.compiler.support) (include "tweaks") diff --git a/ports.import.scm b/ports.import.scm deleted file mode 100644 index 99a76f0..0000000 --- a/ports.import.scm +++ /dev/null @@ -1,44 +0,0 @@ -;;;; ports.import.scm - import library for "ports" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'ports - '(call-with-input-string - call-with-output-string - copy-port - make-input-port - make-output-port - port-for-each - port-map - port-fold - make-broadcast-port - make-concatenated-port - with-error-output-to-port - with-input-from-port - with-input-from-string - with-output-to-port - with-output-to-string - with-error-output-to-port)) diff --git a/ports.scm b/ports.scm index 47c2dea..19317bf 100644 --- a/ports.scm +++ b/ports.scm @@ -36,6 +36,26 @@ (unit ports) (uses extras)) +(module chicken.ports + (call-with-input-string + call-with-output-string + copy-port + make-input-port + make-output-port + port-for-each + port-map + port-fold + make-broadcast-port + make-concatenated-port + with-error-output-to-port + with-input-from-port + with-input-from-string + with-output-to-port + with-output-to-string) + +(import scheme chicken) +(import chicken.extras) + (include "common-declarations.scm") (register-feature! 'ports) @@ -266,3 +286,5 @@ (port (##sys#make-port #f class "(custom)" 'custom)) ) (##sys#set-port-data! port data) port) ) ) + +) diff --git a/posix-common.scm b/posix-common.scm index 69b625d..9f9a213 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -25,7 +25,6 @@ (declare - (hide ##sys#stat posix-error check-time-vector ##sys#find-files) (foreign-declare #< @@ -204,12 +203,15 @@ EOF (er-macro-transformer (lambda (x r c) ;; no need to rename here - (let ((name (cadr x))) + (let* ((mode (cadr x)) + (name (symbol->string mode))) `(##core#begin (declare (foreign-declare - ,(sprintf "#ifndef ~a~%#define ~a S_IFREG~%#endif~%" name name))) - (define-foreign-variable ,name unsigned-int)))))) + ,(string-append "#ifndef " name "\n" + "#define " name "S_IFREG\n" + "#endif\n"))) + (define-foreign-variable ,mode unsigned-int)))))) (stat-mode S_IFLNK) (stat-mode S_IFREG) @@ -352,6 +354,9 @@ EOF (define fileno/stdout _stdout_fileno) (define fileno/stderr _stderr_fileno) +(define open-input-file*) +(define open-output-file*) + (let () (define (mode inp m loc) (##sys#make-c-string diff --git a/posix.import.scm b/posix.import.scm deleted file mode 100644 index 17f38a7..0000000 --- a/posix.import.scm +++ /dev/null @@ -1,248 +0,0 @@ -;;;; posix.import.scm - import library for "posix" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'posix - '(_exit - call-with-input-pipe - call-with-output-pipe - change-directory - change-directory* - change-file-mode - change-file-owner - close-input-pipe - close-output-pipe - create-directory - create-fifo - create-pipe - create-session - create-symbolic-link - current-directory - current-effective-group-id - current-effective-user-id - current-effective-user-name - get-environment-variables - current-group-id - current-process-id - current-user-id - current-user-name - delete-directory - directory - directory? - duplicate-fileno - errno/2big - errno/acces - errno/again - errno/badf - errno/busy - errno/child - errno/deadlk - errno/dom - errno/exist - errno/fault - errno/fbig - errno/ilseq - errno/intr - errno/inval - errno/io - errno/isdir - errno/mfile - errno/mlink - errno/nametoolong - errno/nfile - errno/nodev - errno/noent - errno/noexec - errno/nolck - errno/nomem - errno/nospc - errno/nosys - errno/notdir - errno/notempty - errno/notty - errno/nxio - errno/perm - errno/pipe - errno/range - errno/rofs - errno/spipe - errno/srch - errno/wouldblock - errno/xdev - fcntl/dupfd - fcntl/getfd - fcntl/getfl - fcntl/setfd - fcntl/setfl - fifo? - file-access-time - file-change-time - file-creation-mode - file-close - file-control - file-execute-access? - file-link - file-lock - file-lock/blocking - file-mkstemp - file-modification-time - file-open - file-owner - file-permissions - file-position - set-file-position! - file-read - file-read-access? - file-select - file-size - file-stat - file-test-lock - file-truncate - file-type - file-unlock - file-write - file-write-access? - fileno/stderr - fileno/stdin - fileno/stdout - find-files - get-groups - get-host-name - glob - group-information - initialize-groups - local-time->seconds - local-timezone-abbreviation - open-input-file* - open-input-pipe - open-output-file* - open-output-pipe - open/append - open/binary - open/creat - open/excl - open/fsync - open/noctty - open/nonblock - open/rdonly - open/rdwr - open/read - open/sync - open/text - open/trunc - open/write - open/wronly - parent-process-id - perm/irgrp - perm/iroth - perm/irusr - perm/irwxg - perm/irwxo - perm/irwxu - perm/isgid - perm/isuid - perm/isvtx - perm/iwgrp - perm/iwoth - perm/iwusr - perm/ixgrp - perm/ixoth - perm/ixusr - pipe/buf - port->fileno - process - process* - process-execute - process-fork - process-group-id - process-run - process-signal - process-wait - read-symbolic-link - regular-file? - seconds->local-time - seconds->string - seconds->utc-time - seek/cur - seek/end - seek/set - set-alarm! - set-buffering-mode! - set-groups! - set-root-directory! - set-signal-handler! - set-signal-mask! - setenv - signal-handler - signal-mask - signal-mask! - signal-masked? - signal-unmask! - signal/abrt - signal/alrm - signal/break - signal/chld - signal/cont - signal/fpe - signal/bus - signal/hup - signal/ill - signal/int - signal/io - signal/kill - signal/pipe - signal/prof - signal/quit - signal/segv - signal/stop - signal/term - signal/trap - signal/tstp - signal/urg - signal/usr1 - signal/usr2 - signal/vtalrm - signal/winch - signal/xcpu - signal/xfsz - signals-list - sleep - block-device? - character-device? - fifo? - socket? - string->time - symbolic-link? - system-information - terminal-name - terminal-port? - terminal-size - time->string - unsetenv - user-information - utc-time->seconds - with-input-from-pipe - with-output-to-pipe)) diff --git a/posixunix.scm b/posixunix.scm index 45bd288..8dd4ba3 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -29,21 +29,71 @@ (unit posix) (uses scheduler irregex extras files ports) (disable-interrupts) - (hide group-member _get-groups _ensure-groups posix-error ##sys#terminal-check) (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)) - ;; these are not available on Windows (define-foreign-variable _stat_st_blksize unsigned-int "C_statbuf.st_blksize") (define-foreign-variable _stat_st_blocks unsigned-int "C_statbuf.st_blocks") - -;;; common code +(module chicken.posix + (_exit call-with-input-pipe call-with-output-pipe change-directory + change-directory* change-file-mode change-file-owner close-input-pipe + close-output-pipe create-directory create-fifo create-pipe + create-session create-symbolic-link current-directory + current-effective-group-id current-effective-user-id + current-effective-user-name get-environment-variables + current-group-id current-process-id current-user-id current-user-name + delete-directory directory directory? duplicate-fileno errno/2big + errno/acces errno/again errno/badf errno/busy errno/child + errno/deadlk errno/dom errno/exist errno/fault errno/fbig errno/ilseq + errno/intr errno/inval errno/io errno/isdir errno/mfile errno/mlink + errno/nametoolong errno/nfile errno/nodev errno/noent errno/noexec + errno/nolck errno/nomem errno/nospc errno/nosys errno/notdir + errno/notempty errno/notty errno/nxio errno/perm errno/pipe + errno/range errno/rofs errno/spipe errno/srch errno/wouldblock + errno/xdev fcntl/dupfd fcntl/getfd fcntl/getfl fcntl/setfd + fcntl/setfl fifo? file-access-time file-change-time + file-creation-mode file-close file-control file-execute-access? + file-link file-lock file-lock/blocking file-mkstemp + file-modification-time file-open file-owner file-permissions + file-position set-file-position! file-read file-read-access? + file-select file-size file-stat file-test-lock file-truncate + file-type file-unlock file-write file-write-access? fileno/stderr + fileno/stdin fileno/stdout find-files get-groups get-host-name glob + group-information initialize-groups local-time->seconds + local-timezone-abbreviation open-input-file* open-input-pipe + open-output-file* open-output-pipe open/append open/binary open/creat + open/excl open/fsync open/noctty open/nonblock open/rdonly open/rdwr + open/read open/sync open/text open/trunc open/write open/wronly + parent-process-id perm/irgrp perm/iroth perm/irusr perm/irwxg + perm/irwxo perm/irwxu perm/isgid perm/isuid perm/isvtx perm/iwgrp + perm/iwoth perm/iwusr perm/ixgrp perm/ixoth perm/ixusr pipe/buf + port->fileno process process* process-execute process-fork + process-group-id process-run process-signal process-wait + read-symbolic-link regular-file? seconds->local-time seconds->string + seconds->utc-time seek/cur seek/end seek/set set-alarm! + set-buffering-mode! set-groups! set-root-directory! + set-signal-handler! set-signal-mask! setenv signal-handler + signal-mask signal-mask! signal-masked? signal-unmask! signal/abrt + signal/alrm signal/break signal/chld signal/cont signal/fpe + signal/bus signal/hup signal/ill signal/int signal/io signal/kill + signal/pipe signal/prof signal/quit signal/segv signal/stop + signal/term signal/trap signal/tstp signal/urg signal/usr1 + signal/usr2 signal/vtalrm signal/winch signal/xcpu signal/xfsz + signals-list sleep block-device? character-device? fifo? socket? + string->time symbolic-link? system-information terminal-name + terminal-port? terminal-size time->string unsetenv user-information + utc-time->seconds with-input-from-pipe with-output-to-pipe) + +(import scheme chicken) +(import chicken.files + chicken.foreign + chicken.irregex + chicken.ports) (include "posix-common.scm") - (declare (foreign-declare #<seconds + local-timezone-abbreviation open-input-file* open-input-pipe + open-output-file* open-output-pipe open/append open/binary open/creat + open/excl open/fsync open/noctty open/nonblock open/rdonly open/rdwr + open/read open/sync open/text open/trunc open/write open/wronly + parent-process-id perm/irgrp perm/iroth perm/irusr perm/irwxg + perm/irwxo perm/irwxu perm/isgid perm/isuid perm/isvtx perm/iwgrp + perm/iwoth perm/iwusr perm/ixgrp perm/ixoth perm/ixusr pipe/buf + port->fileno process process* process-execute process-fork + process-group-id process-run process-signal process-wait + read-symbolic-link regular-file? seconds->local-time seconds->string + seconds->utc-time seek/cur seek/end seek/set set-alarm! + set-buffering-mode! set-groups! set-root-directory! + set-signal-handler! set-signal-mask! setenv signal-handler + signal-mask signal-mask! signal-masked? signal-unmask! signal/abrt + signal/alrm signal/break signal/chld signal/cont signal/fpe + #;signal/bus signal/hup signal/ill signal/int signal/io signal/kill + signal/pipe signal/prof signal/quit signal/segv signal/stop + signal/term signal/trap signal/tstp signal/urg signal/usr1 + signal/usr2 signal/vtalrm signal/winch signal/xcpu signal/xfsz + signals-list sleep block-device? character-device? fifo? socket? + string->time symbolic-link? system-information terminal-name + terminal-port? terminal-size time->string unsetenv user-information + utc-time->seconds with-input-from-pipe with-output-to-pipe) + +(import scheme chicken) +(import chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.irregex + chicken.ports) (include "posix-common.scm") @@ -851,6 +909,11 @@ EOF ;;; Pipes: +(define open-input-pipe) +(define open-output-pipe) +(define close-input-pipe) +(define close-output-pipe) + (let () (define (mode arg) (if (pair? arg) (##sys#slot arg 0) '###text)) (define (badmode m) (##sys#error "illegal input/output mode specifier" m)) @@ -1049,6 +1112,10 @@ EOF (define-foreign-variable _w_ok int "4") (define-foreign-variable _x_ok int "2") +(define file-read-access?) +(define file-write-access?) +(define file-execute-access?) + (let () (define (check filename acc loc) (##sys#check-string filename loc) @@ -1451,3 +1518,5 @@ EOF (define perm/isgid 0) (define perm/isuid 0) (define perm/isvtx 0) + +) diff --git a/rules.make b/rules.make index 6988697..d493003 100644 --- a/rules.make +++ b/rules.make @@ -489,6 +489,11 @@ define declare-emitted-import-lib-dependency $(1).import.scm: $(1).c endef +define declare-emitted-chicken-import-lib-dependency +.SECONDARY: chicken.$(1).import.scm +chicken.$(1).import.scm: $(1).c +endef + define declare-emitted-compiler-import-lib-dependency .SECONDARY: chicken.compiler.$(1).import.scm chicken.compiler.$(1).import.scm: $(1).c @@ -497,12 +502,21 @@ endef $(foreach lib, $(SETUP_API_OBJECTS_1),\ $(eval $(call declare-emitted-import-lib-dependency,$(lib)))) +$(foreach lib, $(DYNAMIC_IMPORT_LIBRARIES),\ + $(eval $(call declare-emitted-chicken-import-lib-dependency,$(lib)))) + $(foreach lib, $(filter-out chicken,$(COMPILER_OBJECTS_1)),\ $(eval $(call declare-emitted-compiler-import-lib-dependency,$(lib)))) +# posix declared manually, as it varies based on POSIXFILE +.SECONDARY: chicken.posix.import.scm +chicken.posix.import.scm: $(POSIXFILE).c + chicken.c: chicken.scm \ chicken.compiler.batch-driver.import.scm \ - chicken.compiler.c-platform.import.scm + chicken.compiler.c-platform.import.scm \ + chicken.data-structures.import.scm \ + chicken.utils.import.scm batch-driver.c: batch-driver.scm \ chicken.compiler.core.import.scm \ chicken.compiler.compiler-syntax.import.scm \ @@ -511,26 +525,148 @@ batch-driver.c: batch-driver.scm \ chicken.compiler.c-platform.import.scm \ chicken.compiler.lfa2.import.scm \ chicken.compiler.c-backend.import.scm \ - chicken.compiler.support.import.scm + chicken.compiler.support.import.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm c-platform.c: c-platform.scm \ chicken.compiler.optimizer.import.scm \ chicken.compiler.support.import.scm \ - chicken.compiler.core.import.scm + chicken.compiler.core.import.scm \ + chicken.data-structures.import.scm c-backend.c: c-backend.scm \ chicken.compiler.c-platform.import.scm \ chicken.compiler.support.import.scm \ - chicken.compiler.core.import.scm + chicken.compiler.core.import.scm \ + chicken.data-structures.import.scm core.c: core.scm \ chicken.compiler.scrutinizer.import.scm \ - chicken.compiler.support.import.scm + chicken.compiler.support.import.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.foreign.import.scm optimizer.c: optimizer.scm \ - chicken.compiler.support.import.scm + chicken.compiler.support.import.scm \ + chicken.data-structures.import.scm scrutinizer.c: scrutinizer.scm \ + chicken.compiler.support.import.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.ports.import.scm +lfa2.c: lfa2.scm \ chicken.compiler.support.import.scm -lfa2.c: lfa2.scm chicken.compiler.support.import.scm compiler-syntax.c: compiler-syntax.scm \ chicken.compiler.support.import.scm \ - chicken.compiler.core.import.scm + chicken.compiler.core.import.scm \ + chicken.data-structures.import.scm +chicken-ffi-syntax.c: chicken-ffi-syntax.scm \ + chicken.data-structures.import.scm +support.c: support.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.ports.import.scm +csc.c: csc.scm \ + chicken.data-structures.import.scm \ + chicken.files.import.scm \ + chicken.utils.import.scm +csi.c: csi.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.ports.import.scm +chicken-bug.c: chicken-bug.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.foreign.import.scm \ + chicken.tcp.import.scm \ + chicken.utils.import.scm +chicken-profile.c: chicken-profile.scm \ + chicken.data-structures.import.scm +chicken-status.c: chicken-status.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm \ + chicken.posix.import.scm \ + setup-api.import.scm +chicken-install.c: chicken-install.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm \ + chicken.posix.import.scm \ + chicken.utils.import.scm \ + setup-api.import.scm \ + setup-download.import.scm +chicken-uninstall.c: chicken-uninstall.scm \ + chicken.data-structures.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm \ + chicken.posix.import.scm \ + chicken.utils.import.scm \ + setup-api.import.scm +setup-api.c: setup-api.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm \ + chicken.posix.import.scm \ + chicken.utils.import.scm +setup-download.c: setup-download.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm \ + chicken.posix.import.scm \ + chicken.tcp.import.scm \ + chicken.utils.import.scm \ + setup-api.import.scm +posixunix.c: posixunix.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm +posixwin.c: posixwin.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm \ + chicken.ports.import.scm +data-structures.c: data-structures.scm \ + chicken.foreign.import.scm +extras.c: extras.scm \ + chicken.data-structures.import.scm +files.c: files.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.foreign.import.scm \ + chicken.irregex.import.scm +lolevel.c: lolevel.scm \ + chicken.foreign.import.scm +ports.c: ports.scm \ + chicken.extras.import.scm +tcp.c: tcp.scm \ + chicken.foreign.import.scm \ + chicken.ports.import.scm +utils.c: utils.scm \ + chicken.data-structures.import.scm \ + chicken.extras.import.scm \ + chicken.files.import.scm \ + chicken.foreign.import.scm \ + chicken.posix.import.scm \ + chicken.irregex.import.scm define profile-flags $(if $(filter $(basename $(1)),$(PROFILE_OBJECTS)),-profile) @@ -547,36 +683,33 @@ expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations modules.c: $(SRCDIR)modules.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) extras.c: $(SRCDIR)extras.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.extras posixunix.c: $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.posix posixwin.c: $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.posix irregex.c: $(SRCDIR)irregex.scm $(SRCDIR)irregex-core.scm $(SRCDIR)irregex-utils.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) -# -# The ones below just depend on their matching .scm file and common-declarations -# + $(bootstrap-lib) -emit-import-library chicken.irregex chicken-syntax.c: $(SRCDIR)chicken-syntax.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) chicken-ffi-syntax.c: $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) data-structures.c: $(SRCDIR)data-structures.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.data-structures ports.c: $(SRCDIR)ports.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.ports files.c: $(SRCDIR)files.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.files lolevel.c: $(SRCDIR)lolevel.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.lolevel tcp.c: $(SRCDIR)tcp.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.tcp srfi-1.c: $(SRCDIR)srfi-1.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) srfi-4.c: $(SRCDIR)srfi-4.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) utils.c: $(SRCDIR)utils.scm $(SRCDIR)common-declarations.scm - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.utils scheduler.c: $(SRCDIR)scheduler.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) profiler.c: $(SRCDIR)profiler.scm $(SRCDIR)common-declarations.scm @@ -610,7 +743,7 @@ csi.c: $(SRCDIR)csi.scm $(SRCDIR)banner.scm $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@ chicken-profile.c: $(SRCDIR)chicken-profile.scm $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@ -chicken-install.c: $(SRCDIR)chicken-install.scm setup-download.c setup-api.c +chicken-install.c: $(SRCDIR)chicken-install.scm $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@ chicken-uninstall.c: $(SRCDIR)chicken-uninstall.scm $(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@ @@ -624,7 +757,7 @@ chicken-bug.c: $(SRCDIR)chicken-bug.scm setup-api.c: $(SRCDIR)setup-api.scm $(CHICKEN) $< $(CHICKEN_DYNAMIC_OPTIONS) -emit-import-library setup-api \ -output-file $@ -setup-download.c: $(SRCDIR)setup-download.scm setup-api.c +setup-download.c: $(SRCDIR)setup-download.scm $(CHICKEN) $< $(CHICKEN_DYNAMIC_OPTIONS) -emit-import-library setup-download \ -output-file $@ @@ -640,10 +773,10 @@ dist: distfiles html # Jim's `manual-labor' must be installed (just run "chicken-install manual-labor") html: $(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(SRCDIR)manual-html - manual-labor $(SRCDIR)manual $(SRCDIR)manual-html - $(COPY_COMMAND) $(SRCDIR)chicken.png manual-html - $(COPY_COMMAND) $(SRCDIR)manual.css manual-html - $(COPY_COMMAND) $(SRCDIR)index.html manual-html + #manual-labor $(SRCDIR)manual $(SRCDIR)manual-html + #$(COPY_COMMAND) $(SRCDIR)chicken.png manual-html + #$(COPY_COMMAND) $(SRCDIR)manual.css manual-html + #$(COPY_COMMAND) $(SRCDIR)index.html manual-html # cleaning up @@ -659,9 +792,9 @@ clean: $(LIBCHICKEN_SO_FILE) \ $(PRIMARY_LIBCHICKEN) \ lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX)$(A) \ - $(PROGRAM_IMPORT_LIBRARIES) \ $(IMPORT_LIBRARIES:=.import.so) $(LIBCHICKEN_IMPORT_LIBRARY) \ - $(SETUP_API_OBJECTS_1:=.so) $(SETUP_API_OBJECTS_1:=.import.so) + $(SETUP_API_OBJECTS_1:=.so) $(SETUP_API_OBJECTS_1:=.import.so) \ + $(foreach lib,$(DYNAMIC_IMPORT_LIBRARIES),chicken.$(lib).import.scm) ifdef USES_SONAME $(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX).so.$(BINARYVERSION) endif diff --git a/scripts/makedist.scm b/scripts/makedist.scm index 63dfcdf..64797c4 100644 --- a/scripts/makedist.scm +++ b/scripts/makedist.scm @@ -1,7 +1,7 @@ ;;;; makedist.scm - Make distribution tarballs -(use irregex srfi-1 setup-api) +(use data-structures extras files irregex posix setup-api srfi-1 utils) (define *release* #f) (define *help* #f) diff --git a/scrutinizer.scm b/scrutinizer.scm index c8fa309..9b73128 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -33,8 +33,12 @@ (scrutinize load-type-database emit-type-file validate-type check-and-validate-type install-specializations) -(import chicken scheme srfi-1 data-structures extras ports files - chicken.compiler.support) +(import chicken scheme srfi-1 + chicken.compiler.support + chicken.data-structures + chicken.extras + chicken.files + chicken.ports) (include "tweaks") diff --git a/setup-api.scm b/setup-api.scm index cefa31b..a884eac 100644 --- a/setup-api.scm +++ b/setup-api.scm @@ -65,9 +65,16 @@ shellpath setup-error-handling) - (import scheme chicken foreign - irregex utils posix ports extras data-structures - srfi-1 files) + (import scheme chicken + srfi-1 + chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.ports + chicken.posix + chicken.irregex + chicken.utils) ;;; Constants, variables and parameters diff --git a/setup-download.scm b/setup-download.scm index ba77037..08a8b19 100644 --- a/setup-download.scm +++ b/setup-download.scm @@ -36,9 +36,17 @@ list-extension-versions temporary-directory) - (import scheme chicken foreign) - (import extras irregex posix utils srfi-1 data-structures tcp files - setup-api) + (import scheme chicken) + (import srfi-1 + setup-api + chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.irregex + chicken.posix + chicken.tcp + chicken.utils) (define-constant +default-tcp-connect-timeout+ 30000) ; 30 seconds (define-constant +default-tcp-read/write-timeout+ 30000) ; 30 seconds diff --git a/srfi-4.scm b/srfi-4.scm index 5cd346e..916eb49 100644 --- a/srfi-4.scm +++ b/srfi-4.scm @@ -455,19 +455,19 @@ EOF (define-syntax NNNvector->list (er-macro-transformer (lambda (x r c) - (let* ((tag (##sys#strip-syntax (cadr x))) + (let* ((tag (symbol->string (##sys#strip-syntax (cadr x)))) (alloc? (pair? (cddr x))) - (name (string->symbol (string-append (symbol->string tag) "->list")))) + (name (string->symbol (string-append tag "->list")))) `(define (,name v) - (##sys#check-structure v ',tag ',name) - (let ((len (##core#inline ,(conc "C_u_i_" tag "_length") v))) + (##sys#check-structure v ',(string->symbol tag) ',name) + (let ((len (##core#inline ,(string-append "C_u_i_" tag "_length") v))) (let loop ((i 0)) (if (fx>= i len) '() (cons ,(if alloc? - `(##core#inline_allocate (,(conc "C_a_u_i_" tag "_ref") 4) v i) - `(##core#inline ,(conc "C_u_i_" tag "_ref") v i)) + `(##core#inline_allocate (,(string-append "C_a_u_i_" tag "_ref") 4) v i) + `(##core#inline ,(string-append "C_u_i_" tag "_ref") v i)) (loop (fx+ i 1)) ) ) ) ) ) ) ))) (NNNvector->list u8vector) diff --git a/support.scm b/support.scm index ca0f353..23a8298 100644 --- a/support.scm +++ b/support.scm @@ -75,7 +75,12 @@ ;; in a lot of other places. number-type unsafe) -(import chicken scheme foreign data-structures srfi-1 files extras ports) +(import chicken scheme srfi-1 + chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.ports) (include "tweaks") (include "banner") @@ -1757,4 +1762,4 @@ Available debugging options: EOF )) -) \ No newline at end of file +) diff --git a/tcp.import.scm b/tcp.import.scm deleted file mode 100644 index 4779eb8..0000000 --- a/tcp.import.scm +++ /dev/null @@ -1,44 +0,0 @@ -;;;; tcp.import.scm - import library for "tcp" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'tcp - '(tcp-abandon-port - tcp-accept - tcp-accept-ready? - tcp-accept-timeout - tcp-addresses - tcp-buffer-size - tcp-close - tcp-connect - tcp-connect-timeout - tcp-listen - tcp-listener-fileno - tcp-listener-port - tcp-listener? - tcp-port-numbers - tcp-read-timeout - tcp-write-timeout)) diff --git a/tcp.scm b/tcp.scm index 1652cbc..c6c2d4a 100644 --- a/tcp.scm +++ b/tcp.scm @@ -29,9 +29,6 @@ (unit tcp) (uses ports scheduler) (disable-interrupts) ; Avoid race conditions around errno/WSAGetLastError - (export tcp-close tcp-listen tcp-connect tcp-accept tcp-accept-ready? ##sys#tcp-port->fileno tcp-listener? tcp-addresses - tcp-abandon-port tcp-listener-port tcp-listener-fileno tcp-port-numbers tcp-buffer-size - tcp-read-timeout tcp-write-timeout tcp-accept-timeout tcp-connect-timeout) (foreign-declare #< @@ -140,6 +137,16 @@ static int C_set_socket_options(int socket) EOF ) ) +(module chicken.tcp + (tcp-close tcp-listen tcp-connect tcp-accept tcp-accept-ready? + tcp-listener? tcp-addresses tcp-abandon-port tcp-listener-port + tcp-listener-fileno tcp-port-numbers tcp-buffer-size tcp-read-timeout + tcp-write-timeout tcp-accept-timeout tcp-connect-timeout) + +(import scheme chicken) +(import chicken.foreign + chicken.ports) + (include "common-declarations.scm") (register-feature! 'tcp) @@ -658,3 +665,5 @@ EOF (define (tcp-listener-fileno l) (##sys#check-structure l 'tcp-listener 'tcp-listener-fileno) (##sys#slot l 1) ) + +) diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm index 87b472f..afbb60e 100644 --- a/tests/compiler-tests.scm +++ b/tests/compiler-tests.scm @@ -2,6 +2,7 @@ (import foreign) +(use-for-syntax data-structures) (use srfi-4) ;; test dropping of previous toplevel assignments diff --git a/tests/loopy-test.scm b/tests/loopy-test.scm index 43978f6..003d810 100644 --- a/tests/loopy-test.scm +++ b/tests/loopy-test.scm @@ -1,3 +1,5 @@ +(use (only extras printf)) + (load-relative "loopy-loop.scm") (load-relative "matchable.scm") diff --git a/tests/port-tests.scm b/tests/port-tests.scm index 3577794..1c548e1 100644 --- a/tests/port-tests.scm +++ b/tests/port-tests.scm @@ -1,4 +1,4 @@ -(require-extension srfi-1 ports utils srfi-4 extras tcp posix) +(require-extension data-structures extras files ports posix srfi-4 tcp utils) (include "test.scm") (test-begin) diff --git a/tests/pp-test.scm b/tests/pp-test.scm index 0af80e4..b7f8f59 100644 --- a/tests/pp-test.scm +++ b/tests/pp-test.scm @@ -1,5 +1,7 @@ ;;;; pp-test.scm +(use (only extras pp) + (only ports with-output-to-string)) (define (pp->string thing) (with-output-to-string (cut pp thing))) diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm index 4c98869..da33717 100644 --- a/tests/r7rs-tests.scm +++ b/tests/r7rs-tests.scm @@ -1,5 +1,7 @@ ;; R7RS Tests +(use (only ports with-input-from-string with-output-to-string)) + ;; Copied from R4RS tests (define cur-section '()) diff --git a/tests/reader-tests.scm b/tests/reader-tests.scm index 894e846..a79684d 100644 --- a/tests/reader-tests.scm +++ b/tests/reader-tests.scm @@ -1,7 +1,9 @@ ;;;; reader-tests.scm -(use utils) +(use (only extras read-line) + (only ports with-input-from-string with-output-to-string) + (only utils read-all)) (set-sharp-read-syntax! #\& (lambda (p) (read p) (values))) diff --git a/tests/runtests.bat b/tests/runtests.bat index e94fd10..cea97d6 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -297,7 +297,7 @@ if errorlevel 1 exit /b 1 echo ======================================== r4rstest ... echo (expect mult-float-print-test to fail) -%interpret% -e "(set! ##sys#procedure->string (constantly \"#\"))" -i -s r4rstest.scm >r4rstest.log +%interpret% -R data-structures -e "(set! ##sys#procedure->string (constantly \"#\"))" -i -s r4rstest.scm >r4rstest.log if errorlevel 1 exit /b 1 type r4rstest.log diff --git a/tests/runtests.sh b/tests/runtests.sh index 5e970a6..56b7a69 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -36,13 +36,15 @@ mkdir -p test-repository # copy files into test-repository (by hand to avoid calling `chicken-install'): for x in setup-api.so setup-api.import.so setup-download.so \ - setup-download.import.so chicken.import.so lolevel.import.so \ - srfi-1.import.so srfi-4.import.so data-structures.import.so \ - ports.import.so files.import.so posix.import.so \ - extras.import.so \ - irregex.import.so tcp.import.so \ - foreign.import.so \ - utils.import.so csi.import.so irregex.import.so types.db; do + setup-download.import.so chicken.import.so chicken.lolevel.import.so \ + srfi-1.import.so srfi-4.import.so chicken.data-structures.import.so \ + chicken.ports.import.so chicken.utils.import.so chicken.files.import.so \ + chicken.posix.import.so \ + chicken.extras.import.so \ + chicken.irregex.import.so \ + chicken.tcp.import.so \ + chicken.foreign.import.so \ + csi.import.so types.db; do cp ../$x test-repository done @@ -255,7 +257,7 @@ $interpret -s loopy-test.scm echo "======================================== r4rstest ..." echo "(expect mult-float-print-test to fail)" -$interpret -e '(set! ##sys#procedure->string (constantly "#"))' \ +$interpret -R data-structures -e '(set! ##sys#procedure->string (constantly "#"))' \ -i -s r4rstest.scm >r4rstest.log diff $DIFF_OPTS r4rstest.out r4rstest.log diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm index 81c7c1a..5f80434 100644 --- a/tests/scrutiny-tests.scm +++ b/tests/scrutiny-tests.scm @@ -14,7 +14,7 @@ (let ((bar +)) (bar 3 'a)) ; expected number, got symbol -(pp) ; expected 1 argument, got 0 +(string?) ; expected 1 argument, got 0 (print (cpu-time)) ; expected 1 result, got 2 (print (values)) ; expected 1 result, got 0 diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index e33e84c..902a27f 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -16,7 +16,7 @@ Warning: at toplevel: (scrutiny-tests.scm:15) in procedure call to `bar', expected argument #2 of type `number', but was given an argument of type `symbol' Warning: at toplevel: - (scrutiny-tests.scm:17) in procedure call to `pp', expected 1 argument, but was given 0 arguments + (scrutiny-tests.scm:17) in procedure call to `string?', expected 1 argument, but was given 0 arguments Warning: at toplevel: expected in argument #1 of procedure call `(print (cpu-time))' a single result, but were given 2 results diff --git a/tests/srfi-45-tests.scm b/tests/srfi-45-tests.scm index 1950fd3..9ca2062 100644 --- a/tests/srfi-45-tests.scm +++ b/tests/srfi-45-tests.scm @@ -1,7 +1,8 @@ ;;; Tests adapted from SRFI 45 (for "lazy" -> "delay-force"). ;;; That SRFI Copyright (C) André van Tonder (2003). -(use (only ports with-output-to-string)) +(use (only extras printf) + (only ports with-output-to-string)) (define *errors* 0) diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index ba9b3fc..7e9af3b 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -1,6 +1,6 @@ ;;;; syntax-tests.scm - various macro tests - +(use-for-syntax extras) (use extras) diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm index d275421..5496ed7 100644 --- a/tests/test-irregex.scm +++ b/tests/test-irregex.scm @@ -1,7 +1,7 @@ ;;;: test-irregex.scm -(use extras irregex) +(use data-structures extras irregex ports) (include "test.scm") diff --git a/tests/test.scm b/tests/test.scm index bbe07f8..cb097e2 100644 --- a/tests/test.scm +++ b/tests/test.scm @@ -2,6 +2,7 @@ ; ; by Alex Shinn, lifted from match-test by felix +(use (only data-structures ->string)) (define *pass* 0) (define *fail* 0) diff --git a/tests/version-tests.scm b/tests/version-tests.scm index 0976984..851850c 100644 --- a/tests/version-tests.scm +++ b/tests/version-tests.scm @@ -1,4 +1,4 @@ -(use irregex) +(use data-structures irregex) (let* ((version-tokens (string-split (chicken-version) ".")) (major (string->number (car version-tokens))) diff --git a/types.db b/types.db index 177d2a8..74be29d 100644 --- a/types.db +++ b/types.db @@ -1209,77 +1209,77 @@ ;; data-structures -(->string (procedure ->string (*) string) +(chicken.data-structures#->string (procedure chicken.data-structures#->string (*) string) ((string) #(1))) -(alist-ref (#(procedure #:clean #:enforce #:foldable) alist-ref (* (list-of pair) #!optional (procedure (* *) *) *) *)) -(alist-update! (#(procedure #:enforce) alist-update! (* * (list-of pair) #!optional (procedure (* *) *)) *)) -(alist-update (#(procedure #:clean #:enforce #:foldable) alist-update (* * (list-of pair) #!optional (procedure (* *) *) *) *)) +(chicken.data-structures#alist-ref (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#alist-ref (* (list-of pair) #!optional (procedure (* *) *) *) *)) +(chicken.data-structures#alist-update! (#(procedure #:enforce) chicken.data-structures#alist-update! (* * (list-of pair) #!optional (procedure (* *) *)) *)) +(chicken.data-structures#alist-update (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#alist-update (* * (list-of pair) #!optional (procedure (* *) *) *) *)) -(any? (#(procedure #:pure #:foldable) any? (*) boolean) +(chicken.data-structures#any? (#(procedure #:pure #:foldable) chicken.data-structures#any? (*) boolean) ((*) (let ((#(tmp) #(1))) '#t))) -(atom? (#(procedure #:pure #:foldable) atom? (*) boolean) +(chicken.data-structures#atom? (#(procedure #:pure #:foldable) chicken.data-structures#atom? (*) boolean) ((pair) (let ((#(tmp) #(1))) '#f)) (((not (or pair list))) (let ((#(tmp) #(1))) '#t))) -(butlast (forall (a) (#(procedure #:clean #:enforce) butlast ((pair a *)) (list-of a)))) -(chop (forall (a) (#(procedure #:clean #:enforce) chop ((list-of a) fixnum) (list-of a)))) -(complement (#(procedure #:clean #:enforce) complement ((procedure (#!rest) *)) (procedure (#!rest) boolean))) -(compose (#(procedure #:clean #:enforce) compose (#!rest procedure) procedure)) -(compress (forall (a) (#(procedure #:clean #:enforce) compress (list (list-of a)) (list-of a)))) -(conc (procedure conc (#!rest) string)) -(conjoin (#(procedure #:clean #:enforce) conjoin (#!rest (procedure (*) *)) (procedure (*) *))) -(constantly (forall (a) (#(procedure #:pure) constantly (a) (procedure (#!rest) a)))) -(disjoin (#(procedure #:clean #:enforce) disjoin (#!rest (procedure (*) *)) (procedure (*) *))) -(each (#(procedure #:clean #:enforce) each (#!rest procedure) procedure)) -(flatten (#(procedure #:clean #:enforce) flatten (#!rest *) list)) -(flip (#(procedure #:clean #:enforce) flip ((procedure (* *) . *)) (procedure (* *) . *))) -(identity (forall (a) (#(procedure #:pure #:foldable) identity (a) a))) -(intersperse (#(procedure #:clean #:enforce) intersperse (list *) list)) -(join (#(procedure #:clean #:enforce) join ((list-of list) #!optional list) list)) -(list-of? (#(procedure #:clean #:enforce) list-of? ((procedure (*) *)) (procedure (list) boolean))) - -(merge +(chicken.data-structures#butlast (forall (a) (#(procedure #:clean #:enforce) chicken.data-structures#butlast ((pair a *)) (list-of a)))) +(chicken.data-structures#chop (forall (a) (#(procedure #:clean #:enforce) chicken.data-structures#chop ((list-of a) fixnum) (list-of a)))) +(chicken.data-structures#complement (#(procedure #:clean #:enforce) chicken.data-structures#complement ((procedure (#!rest) *)) (procedure (#!rest) boolean))) +(chicken.data-structures#compose (#(procedure #:clean #:enforce) chicken.data-structures#compose (#!rest procedure) procedure)) +(chicken.data-structures#compress (forall (a) (#(procedure #:clean #:enforce) chicken.data-structures#compress (list (list-of a)) (list-of a)))) +(chicken.data-structures#conc (procedure chicken.data-structures#conc (#!rest) string)) +(chicken.data-structures#conjoin (#(procedure #:clean #:enforce) chicken.data-structures#conjoin (#!rest (procedure (*) *)) (procedure (*) *))) +(chicken.data-structures#constantly (forall (a) (#(procedure #:pure) chicken.data-structures#constantly (a) (procedure (#!rest) a)))) +(chicken.data-structures#disjoin (#(procedure #:clean #:enforce) chicken.data-structures#disjoin (#!rest (procedure (*) *)) (procedure (*) *))) +(chicken.data-structures#each (#(procedure #:clean #:enforce) chicken.data-structures#each (#!rest procedure) procedure)) +(chicken.data-structures#flatten (#(procedure #:clean #:enforce) chicken.data-structures#flatten (#!rest *) list)) +(chicken.data-structures#flip (#(procedure #:clean #:enforce) chicken.data-structures#flip ((procedure (* *) . *)) (procedure (* *) . *))) +(chicken.data-structures#identity (forall (a) (#(procedure #:pure #:foldable) chicken.data-structures#identity (a) a))) +(chicken.data-structures#intersperse (#(procedure #:clean #:enforce) chicken.data-structures#intersperse (list *) list)) +(chicken.data-structures#join (#(procedure #:clean #:enforce) chicken.data-structures#join ((list-of list) #!optional list) list)) +(chicken.data-structures#list-of? (#(procedure #:clean #:enforce) chicken.data-structures#list-of? ((procedure (*) *)) (procedure (list) boolean))) + +(chicken.data-structures#merge (forall (e) - (#(procedure #:enforce) merge ((list-of e) (list-of e) (procedure (e e) *)) (list-of e)))) + (#(procedure #:enforce) chicken.data-structures#merge ((list-of e) (list-of e) (procedure (e e) *)) (list-of e)))) -(merge! +(chicken.data-structures#merge! (forall (e) - (#(procedure #:enforce) merge! ((list-of e) (list-of e) (procedure (e e) *)) (list-of e)))) + (#(procedure #:enforce) chicken.data-structures#merge! ((list-of e) (list-of e) (procedure (e e) *)) (list-of e)))) -(o (#(procedure #:clean #:enforce) o (#!rest (procedure (*) *)) (procedure (*) *))) +(chicken.data-structures#o (#(procedure #:clean #:enforce) chicken.data-structures#o (#!rest (procedure (*) *)) (procedure (*) *))) -(rassoc (#(procedure #:clean #:enforce #:foldable) rassoc (* (list-of pair) #!optional (procedure (* *) *)) *)) -(reverse-string-append (#(procedure #:clean #:enforce) reverse-string-append ((list-of string)) string)) +(chicken.data-structures#rassoc (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#rassoc (* (list-of pair) #!optional (procedure (* *) *)) *)) +(chicken.data-structures#reverse-string-append (#(procedure #:clean #:enforce) chicken.data-structures#reverse-string-append ((list-of string)) string)) -(sort +(chicken.data-structures#sort (forall (e (s (or (vector-of e) (list-of e)))) - (#(procedure #:enforce) - sort - (s (procedure (e e) *)) + (#(procedure #:enforce) + chicken.data-structures#sort + (s (procedure (e e) *)) s))) -(sort! +(chicken.data-structures#sort! (forall (e (s (or (vector-of e) (list-of e)))) - (#(procedure #:enforce) - sort - (s (procedure (e e) *)) + (#(procedure #:enforce) + chicken.data-structures#sort! + (s (procedure (e e) *)) s))) -(sorted? (#(procedure #:enforce) sorted? ((or list vector) (procedure (* *) *)) boolean)) -(topological-sort (#(procedure #:enforce) topological-sort ((list-of list) (procedure (* *) *)) list)) -(string-chomp (#(procedure #:clean #:enforce) string-chomp (string #!optional string) string)) -(string-chop (#(procedure #:clean #:enforce) string-chop (string fixnum) (list-of string))) -(string-compare3 (#(procedure #:clean #:enforce) string-compare3 (string string) fixnum)) -(string-compare3-ci (#(procedure #:clean #:enforce) string-compare3-ci (string string) fixnum)) -(string-intersperse (#(procedure #:clean #:enforce) string-intersperse ((list-of string) #!optional string) string)) -(string-split (#(procedure #:clean #:enforce) string-split (string #!optional string *) (list-of string))) -(string-translate (#(procedure #:clean #:enforce) string-translate (string * #!optional *) string)) -(string-translate* (#(procedure #:clean #:enforce) string-translate* (string (list-of (pair string string))) string)) -(substring-ci=? (#(procedure #:clean #:enforce #:foldable) substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean)) - -(substring-index (#(procedure #:clean #:enforce #:foldable) substring-index (string string #!optional fixnum) (or false fixnum)) +(chicken.data-structures#sorted? (#(procedure #:enforce) chicken.data-structures#sorted? ((or list vector) (procedure (* *) *)) boolean)) +(chicken.data-structures#topological-sort (#(procedure #:enforce) chicken.data-structures#topological-sort ((list-of list) (procedure (* *) *)) list)) +(chicken.data-structures#string-chomp (#(procedure #:clean #:enforce) chicken.data-structures#string-chomp (string #!optional string) string)) +(chicken.data-structures#string-chop (#(procedure #:clean #:enforce) chicken.data-structures#string-chop (string fixnum) (list-of string))) +(chicken.data-structures#string-compare3 (#(procedure #:clean #:enforce) chicken.data-structures#string-compare3 (string string) fixnum)) +(chicken.data-structures#string-compare3-ci (#(procedure #:clean #:enforce) chicken.data-structures#string-compare3-ci (string string) fixnum)) +(chicken.data-structures#string-intersperse (#(procedure #:clean #:enforce) chicken.data-structures#string-intersperse ((list-of string) #!optional string) string)) +(chicken.data-structures#string-split (#(procedure #:clean #:enforce) chicken.data-structures#string-split (string #!optional string *) (list-of string))) +(chicken.data-structures#string-translate (#(procedure #:clean #:enforce) chicken.data-structures#string-translate (string * #!optional *) string)) +(chicken.data-structures#string-translate* (#(procedure #:clean #:enforce) chicken.data-structures#string-translate* (string (list-of (pair string string))) string)) +(chicken.data-structures#substring-ci=? (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean)) + +(chicken.data-structures#substring-index (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#substring-index (string string #!optional fixnum) (or false fixnum)) ((* *) (##sys#substring-index #(1) #(2) '0)) ((* * *) (##sys#substring-index #(1) #(2) #(3)))) @@ -1288,7 +1288,7 @@ (string string fixnum) (or false fixnum))) -(substring-index-ci (#(procedure #:clean #:enforce #:foldable) substring-index-ci (string string #!optional fixnum) (or false fixnum)) +(chicken.data-structures#substring-index-ci (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#substring-index-ci (string string #!optional fixnum) (or false fixnum)) ((* *) (##sys#substring-index-ci #(1) #(2) '0)) ((* * *) (##sys#substring-index-ci #(1) #(2) #(3)))) @@ -1297,61 +1297,61 @@ (string string fixnum) (or false fixnum))) -(substring=? (#(procedure #:clean #:enforce #:foldable) substring=? (string string #!optional fixnum fixnum fixnum) boolean)) -(tail? (#(procedure #:clean) tail? (* *) boolean)) +(chicken.data-structures#substring=? (#(procedure #:clean #:enforce #:foldable) chicken.data-structures#substring=? (string string #!optional fixnum fixnum fixnum) boolean)) +(chicken.data-structures#tail? (#(procedure #:clean) chicken.data-structures#tail? (* *) boolean)) ;; extras -(format (procedure format (#!rest) *)) -(fprintf (#(procedure #:enforce) fprintf (output-port string #!rest) undefined)) -(pp (#(procedure #:enforce) pp (* #!optional output-port) undefined)) -(pretty-print (#(procedure #:enforce) pretty-print (* #!optional output-port) undefined)) -(pretty-print-width (#(procedure #:clean) pretty-print-width (#!optional fixnum) *)) -(printf (#(procedure #:enforce) printf (string #!rest) undefined)) -(random (#(procedure #:clean #:enforce) random (fixnum) fixnum)) -(randomize (#(procedure #:clean #:enforce) randomize (#!optional fixnum) undefined)) -(read-buffered (#(procedure #:enforce) read-buffered (#!optional input-port) string)) -(read-byte (#(procedure #:enforce) read-byte (#!optional input-port) *)) -(read-file (#(procedure #:enforce) read-file (#!optional (or input-port string) (procedure (input-port) *) fixnum) list)) -(read-line (#(procedure #:enforce) read-line (#!optional input-port (or false fixnum)) (or eof string))) -(read-lines (#(procedure #:enforce) read-lines (#!optional (or input-port string) fixnum) (list-of string))) -(read-string (#(procedure #:enforce) read-string (#!optional * input-port) string)) -(read-string! (#(procedure #:enforce) read-string! ((or fixnum false) string #!optional input-port fixnum) fixnum)) -(read-token (#(procedure #:enforce) read-token ((procedure (char) *) #!optional input-port) string)) -(sprintf (#(procedure #:enforce #:foldable) sprintf (string #!rest) string)) -(write-byte (#(procedure #:enforce) write-byte (fixnum #!optional output-port) undefined)) -(write-line (#(procedure #:enforce) write-line (string #!optional output-port) undefined)) -(write-string (#(procedure #:enforce) write-string (string #!optional * output-port) undefined)) +(chicken.extras#format (procedure chicken.extras#format (#!rest) *)) +(chicken.extras#fprintf (#(procedure #:enforce) chicken.extras#fprintf (output-port string #!rest) undefined)) +(chicken.extras#pp (#(procedure #:enforce) chicken.extras#pp (* #!optional output-port) undefined)) +(chicken.extras#pretty-print (#(procedure #:enforce) chicken.extras#pretty-print (* #!optional output-port) undefined)) +(chicken.extras#pretty-print-width (#(procedure #:clean) chicken.extras#pretty-print-width (#!optional fixnum) *)) +(chicken.extras#printf (#(procedure #:enforce) chicken.extras#printf (string #!rest) undefined)) +(chicken.extras#random (#(procedure #:clean #:enforce) chicken.extras#random (fixnum) fixnum)) +(chicken.extras#randomize (#(procedure #:clean #:enforce) chicken.extras#randomize (#!optional fixnum) undefined)) +(chicken.extras#read-buffered (#(procedure #:enforce) chicken.extras#read-buffered (#!optional input-port) string)) +(chicken.extras#read-byte (#(procedure #:enforce) chicken.extras#read-byte (#!optional input-port) *)) +(chicken.extras#read-file (#(procedure #:enforce) chicken.extras#read-file (#!optional (or input-port string) (procedure (input-port) *) fixnum) list)) +(chicken.extras#read-line (#(procedure #:enforce) chicken.extras#read-line (#!optional input-port (or false fixnum)) (or eof string))) +(chicken.extras#read-lines (#(procedure #:enforce) chicken.extras#read-lines (#!optional (or input-port string) fixnum) (list-of string))) +(chicken.extras#read-string (#(procedure #:enforce) chicken.extras#read-string (#!optional * input-port) string)) +(chicken.extras#read-string! (#(procedure #:enforce) chicken.extras#read-string! ((or fixnum false) string #!optional input-port fixnum) fixnum)) +(chicken.extras#read-token (#(procedure #:enforce) chicken.extras#read-token ((procedure (char) *) #!optional input-port) string)) +(chicken.extras#sprintf (#(procedure #:enforce #:foldable) chicken.extras#sprintf (string #!rest) string)) +(chicken.extras#write-byte (#(procedure #:enforce) chicken.extras#write-byte (fixnum #!optional output-port) undefined)) +(chicken.extras#write-line (#(procedure #:enforce) chicken.extras#write-line (string #!optional output-port) undefined)) +(chicken.extras#write-string (#(procedure #:enforce) chicken.extras#write-string (string #!optional * output-port) undefined)) ;; files -(delete-file* (#(procedure #:clean #:enforce) delete-file* (string) *)) -(file-copy (#(procedure #:clean #:enforce) file-copy (string string #!optional * fixnum) fixnum)) -(file-move (#(procedure #:clean #:enforce) file-move (string string #!optional * fixnum) fixnum)) -(make-pathname (#(procedure #:clean #:enforce) make-pathname ((or string (list-of string) false) #!optional (or string false) (or string false)) string)) -(directory-null? (#(procedure #:clean #:enforce) directory-null? (string) boolean)) -(make-absolute-pathname (#(procedure #:clean #:enforce) make-absolute-pathname (* #!optional string string) string)) -(create-temporary-directory (#(procedure #:clean #:enforce) create-temporary-directory () string)) -(create-temporary-file (#(procedure #:clean #:enforce) create-temporary-file (#!optional string) string)) -(decompose-directory (#(procedure #:clean #:enforce) decompose-directory (string) * * *)) -(decompose-pathname (#(procedure #:clean #:enforce) decompose-pathname (string) * * *)) -(absolute-pathname? (#(procedure #:clean #:enforce) absolute-pathname? (string) boolean)) -(pathname-directory (#(procedure #:clean #:enforce) pathname-directory (string) *)) -(pathname-extension (#(procedure #:clean #:enforce) pathname-extension (string) *)) -(pathname-file (#(procedure #:clean #:enforce) pathname-file (string) *)) -(pathname-replace-directory (#(procedure #:clean #:enforce) pathname-replace-directory (string string) string)) -(pathname-replace-extension (#(procedure #:clean #:enforce) pathname-replace-extension (string string) string)) -(pathname-replace-file (#(procedure #:clean #:enforce) pathname-replace-file (string string) string)) -(pathname-strip-directory (#(procedure #:clean #:enforce) pathname-strip-directory (string) string)) -(pathname-strip-extension (#(procedure #:clean #:enforce) pathname-strip-extension (string) string)) -(normalize-pathname (#(procedure #:clean #:enforce) normalize-pathname (string #!optional symbol) string)) +(chicken.files#delete-file* (#(procedure #:clean #:enforce) chicken.files#delete-file* (string) *)) +(chicken.files#file-copy (#(procedure #:clean #:enforce) chicken.files#file-copy (string string #!optional * fixnum) fixnum)) +(chicken.files#file-move (#(procedure #:clean #:enforce) chicken.files#file-move (string string #!optional * fixnum) fixnum)) +(chicken.files#make-pathname (#(procedure #:clean #:enforce) chicken.files#make-pathname ((or string (list-of string) false) #!optional (or string false) (or string false)) string)) +(chicken.files#directory-null? (#(procedure #:clean #:enforce) chicken.files#directory-null? (string) boolean)) +(chicken.files#make-absolute-pathname (#(procedure #:clean #:enforce) chicken.files#make-absolute-pathname (* #!optional string string) string)) +(chicken.files#create-temporary-directory (#(procedure #:clean #:enforce) chicken.files#create-temporary-directory () string)) +(chicken.files#create-temporary-file (#(procedure #:clean #:enforce) chicken.files#create-temporary-file (#!optional string) string)) +(chicken.files#decompose-directory (#(procedure #:clean #:enforce) chicken.files#decompose-directory (string) * * *)) +(chicken.files#decompose-pathname (#(procedure #:clean #:enforce) chicken.files#decompose-pathname (string) * * *)) +(chicken.files#absolute-pathname? (#(procedure #:clean #:enforce) chicken.files#absolute-pathname? (string) boolean)) +(chicken.files#pathname-directory (#(procedure #:clean #:enforce) chicken.files#pathname-directory (string) *)) +(chicken.files#pathname-extension (#(procedure #:clean #:enforce) chicken.files#pathname-extension (string) *)) +(chicken.files#pathname-file (#(procedure #:clean #:enforce) chicken.files#pathname-file (string) *)) +(chicken.files#pathname-replace-directory (#(procedure #:clean #:enforce) chicken.files#pathname-replace-directory (string string) string)) +(chicken.files#pathname-replace-extension (#(procedure #:clean #:enforce) chicken.files#pathname-replace-extension (string string) string)) +(chicken.files#pathname-replace-file (#(procedure #:clean #:enforce) chicken.files#pathname-replace-file (string string) string)) +(chicken.files#pathname-strip-directory (#(procedure #:clean #:enforce) chicken.files#pathname-strip-directory (string) string)) +(chicken.files#pathname-strip-extension (#(procedure #:clean #:enforce) chicken.files#pathname-strip-extension (string) string)) +(chicken.files#normalize-pathname (#(procedure #:clean #:enforce) chicken.files#normalize-pathname (string #!optional symbol) string)) ;; irregex -(irregex (#(procedure #:clean) irregex (#!rest) (struct regexp))) +(chicken.irregex#irregex (#(procedure #:clean) chicken.irregex#irregex (#!rest) (struct regexp))) ;; Both of these DFA accessors return either #f or a DFA vector. ;; TODO: Should we spec out the entire DFA type layout? It's plenty complex, so we don't @@ -1360,100 +1360,99 @@ ;; the car of each list is a number (for init-state), false or an alist; ;; the cdr is a list of alists, which contains a char (or vector) and two alists ;; These alists have types themselves, of course... -(irregex-dfa (#(procedure #:clean #:enforce) irregex-dfa ((struct regexp)) (or false vector)) +(chicken.irregex#irregex-dfa (#(procedure #:clean #:enforce) chicken.irregex#irregex-dfa ((struct regexp)) (or false vector)) (((struct regexp)) (##sys#slot #(1) '1))) -(irregex-dfa/search (#(procedure #:clean #:enforce) irregex-dfa/search ((struct regexp)) (or false vector)) +(chicken.irregex#irregex-dfa/search (#(procedure #:clean #:enforce) chicken.irregex#irregex-dfa/search ((struct regexp)) (or false vector)) (((struct regexp)) (##sys#slot #(1) '2))) ;; Procedure type returned by irregex-nfa is a matcher type (it is misnamed) ;; which is another complex procedure type. -(irregex-nfa (#(procedure #:clean #:enforce) irregex-nfa ((struct regexp)) (or false procedure)) +(chicken.irregex#irregex-nfa (#(procedure #:clean #:enforce) chicken.irregex#irregex-nfa ((struct regexp)) (or false procedure)) (((struct regexp)) (##sys#slot #(1) '3))) -(irregex-flags (#(procedure #:clean #:enforce) irregex-flags ((struct regexp)) fixnum) +(chicken.irregex#irregex-flags (#(procedure #:clean #:enforce) chicken.irregex#irregex-flags ((struct regexp)) fixnum) (((struct regexp)) (##sys#slot #(1) '4))) -(irregex-num-submatches (#(procedure #:clean #:enforce) irregex-num-submatches ((struct regexp)) +(chicken.irregex#irregex-num-submatches (#(procedure #:clean #:enforce) chicken.irregex#irregex-num-submatches ((struct regexp)) fixnum) (((struct regexp)) (##sys#slot #(1) '5))) -(irregex-lengths (#(procedure #:clean #:enforce) irregex-lengths ((struct regexp)) +(chicken.irregex#irregex-lengths (#(procedure #:clean #:enforce) chicken.irregex#irregex-lengths ((struct regexp)) (vector-of (or false pair))) (((struct regexp)) (##sys#slot #(1) '6))) ;; XXX: Submatch names ought to be symbols according to the docs, but this is ;; not enforced anywhere, so we can't assume it in the return type here. -(irregex-names (#(procedure #:clean #:enforce) irregex-names ((struct regexp)) +(chicken.irregex#irregex-names (#(procedure #:clean #:enforce) chicken.irregex#irregex-names ((struct regexp)) (list-of (pair * fixnum))) (((struct regexp)) (##sys#slot #(1) '7))) ;; XXX: specialize these? (how?) -(irregex-extract (#(procedure #:clean #:enforce) irregex-extract (* string #!optional fixnum fixnum) +(chicken.irregex#irregex-extract (#(procedure #:clean #:enforce) chicken.irregex#irregex-extract (* string #!optional fixnum fixnum) (list-of string))) -(irregex-split (#(procedure #:clean #:enforce) irregex-split (* string #!optional fixnum fixnum) +(chicken.irregex#irregex-split (#(procedure #:clean #:enforce) chicken.irregex#irregex-split (* string #!optional fixnum fixnum) (list-of string))) -(irregex-fold (forall (a) (#(procedure #:enforce) irregex-fold (* (procedure (fixnum (struct regexp-match) a) a) a string #!optional (procedure (fixnum *) *) fixnum fixnum) a))) +(chicken.irregex#irregex-fold (forall (a) (#(procedure #:enforce) chicken.irregex#irregex-fold (* (procedure (fixnum (struct regexp-match) a) a) a string #!optional (procedure (fixnum *) *) fixnum fixnum) a))) ;; XXX TODO: chunker is a plain vector -(irregex-fold/chunked (forall (a c) (#(procedure #:enforce) irregex-fold/chunked (* (procedure (c fixnum (struct regexp-match) a) a) a vector c #!optional (procedure (c fixnum a) a) fixnum fixnum) a))) -(irregex-reset-matches! (procedure irregex-reset-matches! ((struct regexp-match)) +(chicken.irregex#irregex-fold/chunked (forall (a c) (#(procedure #:enforce) chicken.irregex#irregex-fold/chunked (* (procedure (c fixnum (struct regexp-match) a) a) a vector c #!optional (procedure (c fixnum a) a) fixnum fixnum) a))) +(chicken.irregex#irregex-reset-matches! (procedure chicken.irregex#irregex-reset-matches! ((struct regexp-match)) (struct regexp-match))) ;; A silly procedure, but at least we can "inline" it like this -(irregex-match? (#(procedure #:clean #:enforce) irregex-match? (* string #!optional fixnum fixnum) - boolean) +(chicken.irregex#irregex-match? (#(procedure #:clean #:enforce) chicken.irregex#irregex-match? (* string #!optional fixnum fixnum) boolean) ((* string) (and (irregex-match #(1) #(2)) '#t)) ((* string fixnum) (and (irregex-match #(1) #(2) #(3)) '#t)) ((* string fixnum fixnum) (and (irregex-match #(1) #(2) #(3) #(4)) '#t))) ;; These two return #f or a match object -(irregex-match (#(procedure #:clean #:enforce) irregex-match (* string #!optional fixnum fixnum) +(chicken.irregex#irregex-match (#(procedure #:clean #:enforce) chicken.irregex#irregex-match (* string #!optional fixnum fixnum) (or false (struct regexp-match)))) ;; XXX chunker is a plain vector ;; Not marked clean because we don't know what chunker procedures will do -(irregex-match/chunked (#(procedure #:enforce) irregex-match/chunked (* vector * #!optional fixnum) +(chicken.irregex#irregex-match/chunked (#(procedure #:enforce) chicken.irregex#irregex-match/chunked (* vector * #!optional fixnum) (or false (struct regexp-match)))) -(irregex-match-data? (#(procedure #:pure #:predicate (struct regexp-match)) irregex-match-data? (*) boolean)) +(chicken.irregex#irregex-match-data? (#(procedure #:pure #:predicate (struct regexp-match)) chicken.irregex#irregex-match-data? (*) boolean)) -(irregex-match-end-index (#(procedure #:clean #:enforce) irregex-match-end-index ((struct regexp-match) #!optional *) fixnum)) -(irregex-match-end-chunk (#(procedure #:clean #:enforce) irregex-match-end-chunk ((struct regexp-match) #!optional *) *)) -(irregex-match-start-index (#(procedure #:clean #:enforce) irregex-match-start-index ((struct regexp-match) #!optional *) fixnum)) -(irregex-match-start-chunk (#(procedure #:clean #:enforce) irregex-match-start-chunk ((struct regexp-match) #!optional *) *)) -(irregex-match-substring (#(procedure #:clean #:enforce) irregex-match-substring ((struct regexp-match) #!optional *) *)) -(irregex-match-subchunk (#(procedure #:clean #:enforce) irregex-match-subchunk ((struct regexp-match) #!optional *) *)) +(chicken.irregex#irregex-match-end-index (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-end-index ((struct regexp-match) #!optional *) fixnum)) +(chicken.irregex#irregex-match-end-chunk (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-end-chunk ((struct regexp-match) #!optional *) *)) +(chicken.irregex#irregex-match-start-index (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-start-index ((struct regexp-match) #!optional *) fixnum)) +(chicken.irregex#irregex-match-start-chunk (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-start-chunk ((struct regexp-match) #!optional *) *)) +(chicken.irregex#irregex-match-substring (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-substring ((struct regexp-match) #!optional *) *)) +(chicken.irregex#irregex-match-subchunk (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-subchunk ((struct regexp-match) #!optional *) *)) -(irregex-match-names (#(procedure #:clean #:enforce) irregex-match-names ((struct regexp-match)) list) +(chicken.irregex#irregex-match-names (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-names ((struct regexp-match)) list) (((struct regexp-match)) (##sys#slot #(1) '2))) -(irregex-match-num-submatches (#(procedure #:enforce) irregex-match-num-submatches ((struct regexp-match)) fixnum) +(chicken.irregex#irregex-match-num-submatches (#(procedure #:enforce) chicken.irregex#irregex-match-num-submatches ((struct regexp-match)) fixnum) (((struct regexp-match)) (fx- (fx/ (##sys#size (##sys#slot #(1) '1)) '4) '2))) -(irregex-new-matches (procedure irregex-new-matches (*) *)) ; really only for internal use.. -(irregex-opt (#(procedure #:clean #:enforce) irregex-opt (list) *)) -(irregex-quote (#(procedure #:clean #:enforce) irregex-quote (string) string)) +(chicken.irregex#irregex-new-matches (procedure chicken.irregex#irregex-new-matches (*) *)) ; really only for internal use.. +(chicken.irregex#irregex-opt (#(procedure #:clean #:enforce) chicken.irregex#irregex-opt (list) *)) +(chicken.irregex#irregex-quote (#(procedure #:clean #:enforce) chicken.irregex#irregex-quote (string) string)) -(irregex-replace (#(procedure #:enforce) irregex-replace (* string #!rest) string)) -(irregex-replace/all (#(procedure #:enforce) irregex-replace/all (* string #!rest) string)) +(chicken.irregex#irregex-replace (#(procedure #:enforce) chicken.irregex#irregex-replace (* string #!rest) string)) +(chicken.irregex#irregex-replace/all (#(procedure #:enforce) chicken.irregex#irregex-replace/all (* string #!rest) string)) ;; Returns a list of strings, but *only* when all user-procedures do -(irregex-apply-match (procedure ((struct regexp-match) list) list)) ; internal use +(chicken.irregex#irregex-apply-match (procedure ((struct regexp-match) list) list)) ; internal use ;; These return #f or a match object -(irregex-search (#(procedure #:clean #:enforce) irregex-search (* string #!optional fixnum fixnum) +(chicken.irregex#irregex-search (#(procedure #:clean #:enforce) chicken.irregex#irregex-search (* string #!optional fixnum fixnum) (or false (struct regexp-match)))) ;; XXX chunker is a plain vector -(irregex-search/chunked (#(procedure #:enforce) irregex-search/chunked (* vector * #!optional fixnum *) +(chicken.irregex#irregex-search/chunked (#(procedure #:enforce) chicken.irregex#irregex-search/chunked (* vector * #!optional fixnum *) (or false (struct regexp-match)))) -(irregex-search/matches (#(procedure #:enforce) irregex-search/matches (* vector * * fixnum (struct regexp-match)) +(chicken.irregex#irregex-search/matches (#(procedure #:enforce) chicken.irregex#irregex-search/matches (* vector * * fixnum (struct regexp-match)) (or false (struct regexp-match)))) -(irregex-match-valid-index? - (#(procedure #:clean #:enforce) irregex-match-valid-index? ((struct regexp-match) *) boolean)) +(chicken.irregex#irregex-match-valid-index? + (#(procedure #:clean #:enforce) chicken.irregex#irregex-match-valid-index? ((struct regexp-match) *) boolean)) -(irregex? (#(procedure #:pure #:predicate (struct regexp)) irregex? (*) boolean)) +(chicken.irregex#irregex? (#(procedure #:pure #:predicate (struct regexp)) chicken.irregex#irregex? (*) boolean)) -(make-irregex-chunker - (#(procedure #:enforce) make-irregex-chunker +(chicken.irregex#make-irregex-chunker + (#(procedure #:enforce) chicken.irregex#make-irregex-chunker ((procedure (*) *) (procedure (*) *) #!optional @@ -1462,39 +1461,39 @@ (procedure (* fixnum * fixnum) string) (procedure (* fixnum * fixnum) *)) *)) -(maybe-string->sre (#(procedure #:clean) maybe-string->sre (*) *)) -(sre->irregex (#(procedure #:clean) sre->irregex (#!rest) *)) -(string->irregex (#(procedure #:clean #:enforce) string->irregex (string #!rest) *)) -(string->sre (#(procedure #:clean #:enforce) string->sre (string #!rest) *)) +(chicken.irregex#maybe-string->sre (#(procedure #:clean) chicken.irregex#maybe-string->sre (*) *)) +(chicken.irregex#sre->irregex (#(procedure #:clean) chicken.irregex#sre->irregex (#!rest) *)) +(chicken.irregex#string->irregex (#(procedure #:clean #:enforce) chicken.irregex#string->irregex (string #!rest) *)) +(chicken.irregex#string->sre (#(procedure #:clean #:enforce) chicken.irregex#string->sre (string #!rest) *)) ;; lolevel -(address->pointer (#(procedure #:clean #:enforce) address->pointer (fixnum) pointer) +(chicken.lolevel#address->pointer (#(procedure #:clean #:enforce) chicken.lolevel#address->pointer (fixnum) pointer) ((fixnum) (##sys#address->pointer #(1)))) -(align-to-word +(chicken.lolevel#align-to-word (#(procedure #:clean) - align-to-word + chicken.lolevel#align-to-word ((or number pointer locative procedure port)) (or pointer number))) -(allocate (#(procedure #:clean #:enforce) allocate (fixnum) (or false pointer))) -(block-ref (#(procedure #:clean #:enforce) block-ref (* fixnum) *)) -(block-set! (#(procedure #:enforce) block-set! (* fixnum *) *)) -(extend-procedure (#(procedure #:clean #:enforce) extend-procedure (procedure *) procedure)) -(extended-procedure? (#(procedure #:clean) extended-procedure (*) boolean)) -(free (#(procedure #:clean #:enforce) free (pointer) undefined)) -(locative->object (#(procedure #:clean #:enforce) locative->object (locative) *)) -(locative-ref (#(procedure #:clean #:enforce) locative-ref (locative) *)) -(locative-set! (#(procedure #:enforce) locative-set! (locative *) *)) -(locative? (#(procedure #:pure #:predicate locative) locative? (*) boolean)) -(make-locative (#(procedure #:clean #:enforce) make-locative (* #!optional fixnum) locative)) -(make-pointer-vector (#(procedure #:clean #:enforce) make-pointer-vector (fixnum #!optional (or pointer false)) pointer-vector)) -(make-record-instance (#(procedure #:clean) make-record-instance (symbol #!rest) *)) -(make-weak-locative (#(procedure #:clean #:enforce) make-weak-locative (* #!optional fixnum) locative)) - -(move-memory! (#(procedure #:enforce) move-memory! (* * #!optional fixnum fixnum fixnum) *) +(chicken.lolevel#allocate (#(procedure #:clean #:enforce) chicken.lolevel#allocate (fixnum) (or false pointer))) +(chicken.lolevel#block-ref (#(procedure #:clean #:enforce) chicken.lolevel#block-ref (* fixnum) *)) +(chicken.lolevel#block-set! (#(procedure #:enforce) chicken.lolevel#block-set! (* fixnum *) *)) +(chicken.lolevel#extend-procedure (#(procedure #:clean #:enforce) chicken.lolevel#extend-procedure (procedure *) procedure)) +(chicken.lolevel#extended-procedure? (#(procedure #:clean) chicken.lolevel#extended-procedure (*) boolean)) +(chicken.lolevel#free (#(procedure #:clean #:enforce) chicken.lolevel#free (pointer) undefined)) +(chicken.lolevel#locative->object (#(procedure #:clean #:enforce) chicken.lolevel#locative->object (locative) *)) +(chicken.lolevel#locative-ref (#(procedure #:clean #:enforce) chicken.lolevel#locative-ref (locative) *)) +(chicken.lolevel#locative-set! (#(procedure #:enforce) chicken.lolevel#locative-set! (locative *) *)) +(chicken.lolevel#locative? (#(procedure #:pure #:predicate locative) chicken.lolevel#locative? (*) boolean)) +(chicken.lolevel#make-locative (#(procedure #:clean #:enforce) chicken.lolevel#make-locative (* #!optional fixnum) locative)) +(chicken.lolevel#make-pointer-vector (#(procedure #:clean #:enforce) chicken.lolevel#make-pointer-vector (fixnum #!optional (or pointer false)) pointer-vector)) +(chicken.lolevel#make-record-instance (#(procedure #:clean) chicken.lolevel#make-record-instance (symbol #!rest) *)) +(chicken.lolevel#make-weak-locative (#(procedure #:clean #:enforce) chicken.lolevel#make-weak-locative (* #!optional fixnum) locative)) + +(chicken.lolevel#move-memory! (#(procedure #:enforce) chicken.lolevel#move-memory! (* * #!optional fixnum fixnum fixnum) *) ((pointer pointer fixnum) (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0)) ((pointer pointer fixnum fixnum) @@ -1508,110 +1507,110 @@ ((locative locative fixnum fixnum fixnum) (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4)))) -(mutate-procedure! - (#(procedure #:enforce) mutate-procedure! (procedure (procedure (procedure) . *)) procedure)) +(chicken.lolevel#mutate-procedure! + (#(procedure #:enforce) chicken.lolevel#mutate-procedure! (procedure (procedure (procedure) . *)) procedure)) -(number-of-bytes (#(procedure #:clean) number-of-bytes (*) fixnum) +(chicken.lolevel#number-of-bytes (#(procedure #:clean) chicken.lolevel#number-of-bytes (*) fixnum) (((or blob string)) (##sys#size #(1))) (((or port procedure symbol pair vector locative float pointer-vector)) ;; would be applicable to all structure types, but we can't specify ;; "(struct *)" (yet) (##core#inline "C_bytes" (##sys#size #(1))))) -(number-of-slots (#(procedure #:clean #:foldable) number-of-slots (*) fixnum) +(chicken.lolevel#number-of-slots (#(procedure #:clean #:foldable) chicken.lolevel#number-of-slots (*) fixnum) (((or vector symbol pair)) (##sys#size #(1)))) -(object->pointer (#(procedure #:clean) object->pointer (*) *)) -(object-become! (procedure object-become! (list) *)) -(object-copy (#(procedure #:clean) object-copy (*) *)) -(pointer+ (#(procedure #:clean #:enforce) pointer+ ((or pointer procedure port locative) fixnum) pointer)) +(chicken.lolevel#object->pointer (#(procedure #:clean) chicken.lolevel#object->pointer (*) *)) +(chicken.lolevel#object-become! (procedure chicken.lolevel#object-become! (list) *)) +(chicken.lolevel#object-copy (#(procedure #:clean) chicken.lolevel#object-copy (*) *)) +(chicken.lolevel#pointer+ (#(procedure #:clean #:enforce) chicken.lolevel#pointer+ ((or pointer procedure port locative) fixnum) pointer)) -(pointer->address (#(procedure #:clean #:enforce) pointer->address ((or pointer procedure port locative)) number) +(chicken.lolevel#pointer->address (#(procedure #:clean #:enforce) chicken.lolevel#pointer->address ((or pointer procedure port locative)) number) ((pointer) (##sys#pointer->address #(1)))) -(pointer->object (#(procedure #:clean #:enforce) pointer->object (pointer) *) +(chicken.lolevel#pointer->object (#(procedure #:clean #:enforce) chicken.lolevel#pointer->object (pointer) *) ((pointer) (##core#inline "C_pointer_to_object" #(1)))) -(pointer-like? (#(procedure #:pure #:predicate (or pointer locative procedure port)) pointer-like? (*) boolean) +(chicken.lolevel#pointer-like? (#(procedure #:pure #:predicate (or pointer locative procedure port)) chicken.lolevel#pointer-like? (*) boolean) (((or pointer locative procedure port)) (let ((#(tmp) #(1))) '#t))) -(pointer-f32-ref (#(procedure #:clean #:enforce) pointer-f32-ref (pointer) number)) -(pointer-f32-set! (#(procedure #:clean #:enforce) pointer-f32-set! (pointer number) undefined)) -(pointer-f64-ref (#(procedure #:clean #:enforce) pointer-f64-ref (pointer) number)) -(pointer-f64-set! (#(procedure #:clean #:enforce) pointer-f64-set! (pointer number) undefined)) -(pointer-vector (#(procedure #:clean #:enforce) pointer-vector (#!rest pointer-vector) boolean)) +(chicken.lolevel#pointer-f32-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-f32-ref (pointer) number)) +(chicken.lolevel#pointer-f32-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-f32-set! (pointer number) undefined)) +(chicken.lolevel#pointer-f64-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-f64-ref (pointer) number)) +(chicken.lolevel#pointer-f64-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-f64-set! (pointer number) undefined)) +(chicken.lolevel#pointer-vector (#(procedure #:clean #:enforce) chicken.lolevel#pointer-vector (#!rest pointer-vector) boolean)) -(pointer-vector? (#(procedure #:pure #:predicate pointer-vector) pointer-vector? (*) boolean)) +(chicken.lolevel#pointer-vector? (#(procedure #:pure #:predicate pointer-vector) chicken.lolevel#pointer-vector? (*) boolean)) -(pointer-vector-fill! (#(procedure #:clean #:enforce) pointer-vector-fill! (pointer-vector (or pointer false)) undefined)) +(chicken.lolevel#pointer-vector-fill! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-vector-fill! (pointer-vector (or pointer false)) undefined)) -(pointer-vector-length (#(procedure #:clean #:enforce) pointer-vector-length (pointer-vector) fixnum) +(chicken.lolevel#pointer-vector-length (#(procedure #:clean #:enforce) chicken.lolevel#pointer-vector-length (pointer-vector) fixnum) ((pointer-vector) (##sys#slot #(1) '1))) -(pointer-vector-ref (#(procedure #:clean #:enforce) pointer-vector-ref (pointer-vector fixnum) (or pointer false))) -(pointer-vector-set! (#(procedure #:clean #:enforce) pointer-vector-set! (pointer-vector fixnum (or pointer false)) undefined)) -(pointer-s16-ref (#(procedure #:clean #:enforce) pointer-s16-ref (pointer) fixnum)) -(pointer-s16-set! (#(procedure #:clean #:enforce) pointer-s16-set! (pointer fixnum) undefined)) -(pointer-s32-ref (#(procedure #:clean #:enforce) pointer-s32-ref (pointer) number)) -(pointer-s32-set! (#(procedure #:clean #:enforce) pointer-s32-set! (pointer number) undefined)) -(pointer-s8-ref (#(procedure #:clean #:enforce) pointer-s8-ref (pointer) fixnum)) -(pointer-s8-set! (#(procedure #:clean #:enforce) pointer-s8-set! (pointer fixnum) undefined)) +(chicken.lolevel#pointer-vector-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-vector-ref (pointer-vector fixnum) (or pointer false))) +(chicken.lolevel#pointer-vector-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-vector-set! (pointer-vector fixnum (or pointer false)) undefined)) +(chicken.lolevel#pointer-s16-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-s16-ref (pointer) fixnum)) +(chicken.lolevel#pointer-s16-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-s16-set! (pointer fixnum) undefined)) +(chicken.lolevel#pointer-s32-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-s32-ref (pointer) number)) +(chicken.lolevel#pointer-s32-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-s32-set! (pointer number) undefined)) +(chicken.lolevel#pointer-s8-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-s8-ref (pointer) fixnum)) +(chicken.lolevel#pointer-s8-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-s8-set! (pointer fixnum) undefined)) -(pointer-tag (#(procedure #:clean #:enforce) pointer-tag ((or pointer locative procedure port)) *) +(chicken.lolevel#pointer-tag (#(procedure #:clean #:enforce) chicken.lolevel#pointer-tag ((or pointer locative procedure port)) *) (((or locative procedure port)) (let ((#(tmp) #(1))) '#f))) -(pointer-u16-ref (#(procedure #:clean #:enforce) pointer-u16-ref (pointer) fixnum)) -(pointer-u16-set! (#(procedure #:clean #:enforce) pointer-u16-set! (pointer fixnum) undefined)) -(pointer-u32-ref (#(procedure #:clean #:enforce) pointer-u32-ref (pointer) number)) -(pointer-u32-set! (#(procedure #:clean #:enforce) pointer-u32-set! (pointer number) undefined)) -(pointer-u8-ref (#(procedure #:clean #:enforce) pointer-u8-ref (pointer) fixnum)) -(pointer-u8-set! (#(procedure #:clean #:enforce) pointer-u8-set! (pointer fixnum) undefined)) +(chicken.lolevel#pointer-u16-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-u16-ref (pointer) fixnum)) +(chicken.lolevel#pointer-u16-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-u16-set! (pointer fixnum) undefined)) +(chicken.lolevel#pointer-u32-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-u32-ref (pointer) number)) +(chicken.lolevel#pointer-u32-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-u32-set! (pointer number) undefined)) +(chicken.lolevel#pointer-u8-ref (#(procedure #:clean #:enforce) chicken.lolevel#pointer-u8-ref (pointer) fixnum)) +(chicken.lolevel#pointer-u8-set! (#(procedure #:clean #:enforce) chicken.lolevel#pointer-u8-set! (pointer fixnum) undefined)) -(pointer=? (#(procedure #:clean #:enforce) pointer=? ((or pointer locative procedure port) +(chicken.lolevel#pointer=? (#(procedure #:clean #:enforce) chicken.lolevel#pointer=? ((or pointer locative procedure port) (or pointer locative procedure port)) boolean) ((pointer pointer) (##core#inline "C_pointer_eqp" #(1) #(2)))) -(pointer? (#(procedure #:clean #:predicate pointer) pointer? (*) boolean)) +(chicken.lolevel#pointer? (#(procedure #:clean #:predicate pointer) chicken.lolevel#pointer? (*) boolean)) -(procedure-data (#(procedure #:clean #:enforce) procedure-data (procedure) *)) -(record->vector (#(procedure #:clean) record->vector (*) vector)) +(chicken.lolevel#procedure-data (#(procedure #:clean #:enforce) chicken.lolevel#procedure-data (procedure) *)) +(chicken.lolevel#record->vector (#(procedure #:clean) chicken.lolevel#record->vector (*) vector)) -(record-instance? (#(procedure #:clean) record-instance? (* #!optional symbol) boolean) +(chicken.lolevel#record-instance? (#(procedure #:clean) chicken.lolevel#record-instance? (* #!optional symbol) boolean) ((* symbol) (##sys#structure? #(1) #(2))) ((*) (let ((#(tmp) #(1))) (if (##sys#immediate? #(tmp)) '#f (##sys#generic-structure? #(tmp)))))) -(record-instance-length (#(procedure #:clean) record-instance-length (*) fixnum)) -(record-instance-slot (#(procedure #:clean #:enforce) record-instance-slot (* fixnum) *)) -(record-instance-slot-set! (#(procedure #:clean #:enforce) record-instance-slot-set! (* fixnum *) undefined)) -(record-instance-type (#(procedure #:clean) record-instance-type (*) *)) -(set-procedure-data! (#(procedure #:clean #:enforce) set-procedure-data! (procedure *) undefined)) -(tag-pointer (#(procedure #:clean #:enforce) tag-pointer (pointer *) pointer)) -(tagged-pointer? (#(procedure #:clean #:enforce) tagged-pointer? (* #!optional *) boolean)) +(chicken.lolevel#record-instance-length (#(procedure #:clean) chicken.lolevel#record-instance-length (*) fixnum)) +(chicken.lolevel#record-instance-slot (#(procedure #:clean #:enforce) chicken.lolevel#record-instance-slot (* fixnum) *)) +(chicken.lolevel#record-instance-slot-set! (#(procedure #:clean #:enforce) chicken.lolevel#record-instance-slot-set! (* fixnum *) undefined)) +(chicken.lolevel#record-instance-type (#(procedure #:clean) chicken.lolevel#record-instance-type (*) *)) +(chicken.lolevel#set-procedure-data! (#(procedure #:clean #:enforce) chicken.lolevel#set-procedure-data! (procedure *) undefined)) +(chicken.lolevel#tag-pointer (#(procedure #:clean #:enforce) chicken.lolevel#tag-pointer (pointer *) pointer)) +(chicken.lolevel#tagged-pointer? (#(procedure #:clean #:enforce) chicken.lolevel#tagged-pointer? (* #!optional *) boolean)) ;; ports -(call-with-input-string (#(procedure #:enforce) call-with-input-string (string (procedure (input-port) . *)) . *)) -(call-with-output-string (#(procedure #:enforce) call-with-output-string ((procedure (output-port) . *)) string)) -(copy-port (#(procedure #:enforce) copy-port (* * #!optional (procedure (*) *) (procedure (* output-port) *)) undefined)) -(make-input-port (#(procedure #:clean #:enforce) make-input-port ((procedure () (or char eof)) (procedure () *) (procedure () . *) #!optional * * * *) input-port)) -(make-output-port (#(procedure #:clean #:enforce) make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) output-port)) -(port-for-each (#(procedure #:enforce) port-for-each ((procedure (*) *) (procedure () . *)) undefined)) +(chicken.ports#call-with-input-string (#(procedure #:enforce) chicken.ports#call-with-input-string (string (procedure (input-port) . *)) . *)) +(chicken.ports#call-with-output-string (#(procedure #:enforce) chicken.ports#call-with-output-string ((procedure (output-port) . *)) string)) +(chicken.ports#copy-port (#(procedure #:enforce) chicken.ports#copy-port (* * #!optional (procedure (*) *) (procedure (* output-port) *)) undefined)) +(chicken.ports#make-input-port (#(procedure #:clean #:enforce) chicken.ports#make-input-port ((procedure () (or char eof)) (procedure () *) (procedure () . *) #!optional * * * *) input-port)) +(chicken.ports#make-output-port (#(procedure #:clean #:enforce) chicken.ports#make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) output-port)) +(chicken.ports#port-for-each (#(procedure #:enforce) chicken.ports#port-for-each ((procedure (*) *) (procedure () . *)) undefined)) -(port-map - (forall (a b) (#(procedure #:enforce) port-map ((procedure (a) b) (procedure () a)) (list-of b)))) +(chicken.ports#port-map + (forall (a b) (#(procedure #:enforce) chicken.ports#port-map ((procedure (a) b) (procedure () a)) (list-of b)))) -(port-fold (#(procedure #:enforce) port-fold ((procedure (* *) *) * (procedure () *)) *)) -(make-broadcast-port (#(procedure #:clean #:enforce) make-broadcast-port (#!rest output-port) output-port)) -(make-concatenated-port (#(procedure #:clean #:enforce) make-concatenated-port (port #!rest input-port) input-port)) -(with-error-output-to-port (#(procedure #:enforce) with-error-output-to-port (output-port (procedure () . *)) . *)) -(with-input-from-port (#(procedure #:enforce) with-input-from-port (input-port (procedure () . *)) . *)) -(with-input-from-string (#(procedure #:enforce) with-input-from-string (string (procedure () . *)) . *)) -(with-output-to-port (#(procedure #:enforce) with-output-to-port (output-port (procedure () . *)) . *)) -(with-output-to-string (#(procedure #:enforce) with-output-to-string ((procedure () . *)) . *)) +(chicken.ports#port-fold (#(procedure #:enforce) chicken.ports#port-fold ((procedure (* *) *) * (procedure () *)) *)) +(chicken.ports#make-broadcast-port (#(procedure #:clean #:enforce) chicken.ports#make-broadcast-port (#!rest output-port) output-port)) +(chicken.ports#make-concatenated-port (#(procedure #:clean #:enforce) chicken.ports#make-concatenated-port (port #!rest input-port) input-port)) +(chicken.ports#with-error-output-to-port (#(procedure #:enforce) chicken.ports#with-error-output-to-port (output-port (procedure () . *)) . *)) +(chicken.ports#with-input-from-port (#(procedure #:enforce) chicken.ports#with-input-from-port (input-port (procedure () . *)) . *)) +(chicken.ports#with-input-from-string (#(procedure #:enforce) chicken.ports#with-input-from-string (string (procedure () . *)) . *)) +(chicken.ports#with-output-to-port (#(procedure #:enforce) chicken.ports#with-output-to-port (output-port (procedure () . *)) . *)) +(chicken.ports#with-output-to-string (#(procedure #:enforce) chicken.ports#with-output-to-string ((procedure () . *)) . *)) ;; posix @@ -2221,35 +2220,35 @@ ;; tcp -(tcp-abandon-port (#(procedure #:clean #:enforce) tcp-abandon-port (port) undefined)) -(tcp-accept (#(procedure #:clean #:enforce) tcp-accept ((struct tcp-listener)) input-port output-port)) -(tcp-accept-ready? (#(procedure #:clean #:enforce) tcp-accept-ready? ((struct tcp-listener)) boolean)) -(tcp-accept-timeout (#(procedure #:clean #:enforce) tcp-accept-timeout (#!optional (or false number)) (or false number))) -(tcp-addresses (#(procedure #:clean #:enforce) tcp-addresses (port) string string)) -(tcp-buffer-size (#(procedure #:clean #:enforce) tcp-buffer-size (#!optional fixnum) fixnum)) -(tcp-close (#(procedure #:clean #:enforce) tcp-close ((struct tcp-listener)) undefined)) -(tcp-connect (#(procedure #:clean #:enforce) tcp-connect (string #!optional fixnum) input-port output-port)) -(tcp-connect-timeout (#(procedure #:clean #:enforce) tcp-connect-timeout (#!optional (or false number)) (or false number))) -(tcp-listen (#(procedure #:clean #:enforce) tcp-listen (fixnum #!optional fixnum *) (struct tcp-listener))) - -(tcp-listener-fileno (#(procedure #:clean #:enforce) tcp-listener-fileno ((struct tcp-listener)) fixnum) +(chicken.tcp#tcp-abandon-port (#(procedure #:clean #:enforce) chicken.tcp#tcp-abandon-port (port) undefined)) +(chicken.tcp#tcp-accept (#(procedure #:clean #:enforce) chicken.tcp#tcp-accept ((struct tcp-listener)) input-port output-port)) +(chicken.tcp#tcp-accept-ready? (#(procedure #:clean #:enforce) chicken.tcp#tcp-accept-ready? ((struct tcp-listener)) boolean)) +(chicken.tcp#tcp-accept-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-accept-timeout (#!optional (or false number)) (or false number))) +(chicken.tcp#tcp-addresses (#(procedure #:clean #:enforce) chicken.tcp#tcp-addresses (port) string string)) +(chicken.tcp#tcp-buffer-size (#(procedure #:clean #:enforce) chicken.tcp#tcp-buffer-size (#!optional fixnum) fixnum)) +(chicken.tcp#tcp-close (#(procedure #:clean #:enforce) chicken.tcp#tcp-close ((struct tcp-listener)) undefined)) +(chicken.tcp#tcp-connect (#(procedure #:clean #:enforce) chicken.tcp#tcp-connect (string #!optional fixnum) input-port output-port)) +(chicken.tcp#tcp-connect-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-connect-timeout (#!optional (or false number)) (or false number))) +(chicken.tcp#tcp-listen (#(procedure #:clean #:enforce) chicken.tcp#tcp-listen (fixnum #!optional fixnum *) (struct tcp-listener))) + +(chicken.tcp#tcp-listener-fileno (#(procedure #:clean #:enforce) chicken.tcp#tcp-listener-fileno ((struct tcp-listener)) fixnum) (((struct tcp-listener)) (##sys#slot #(1) '1))) -(tcp-listener-port (#(procedure #:clean #:enforce) tcp-listener-port ((struct tcp-listener)) fixnum)) +(chicken.tcp#tcp-listener-port (#(procedure #:clean #:enforce) chicken.tcp#tcp-listener-port ((struct tcp-listener)) fixnum)) -(tcp-listener? (#(procedure #:clean #:predicate (struct tcp-listener)) tcp-listener? (*) boolean)) +(chicken.tcp#tcp-listener? (#(procedure #:clean #:predicate (struct tcp-listener)) chicken.tcp#tcp-listener? (*) boolean)) -(tcp-port-numbers (#(procedure #:clean #:enforce) tcp-port-numbers (port) fixnum fixnum)) -(tcp-read-timeout (#(procedure #:clean #:enforce) tcp-read-timeout (#!optional (or false number)) (or false number))) -(tcp-write-timeout (#(procedure #:clean #:enforce) tcp-write-timeout (#!optional (or false number)) (or false number))) +(chicken.tcp#tcp-port-numbers (#(procedure #:clean #:enforce) chicken.tcp#tcp-port-numbers (port) fixnum fixnum)) +(chicken.tcp#tcp-read-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-read-timeout (#!optional (or false number)) (or false number))) +(chicken.tcp#tcp-write-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-write-timeout (#!optional (or false number)) (or false number))) ;; utils -(read-all (#(procedure #:enforce) read-all (#!optional (or input-port string)) string)) -(system* (#(procedure #:clean #:enforce) system* (string #!rest) undefined)) -(qs (#(procedure #:clean #:enforce) qs (string) string)) -(compile-file (#(procedure #:clean #:enforce) compile-file (string #!rest) (or false string))) -(compile-file-options (#(procedure #:clean #:enforce) compile-file-options (#!optional (list-of string)) (list-of string))) -(scan-input-lines (#(procedure #:enforce) scan-input-lines (* #!optional input-port) *)) -(yes-or-no? (#(procedure #:enforce) yes-or-no? (string #!rest) *)) +(chicken.utils#read-all (#(procedure #:enforce) chicken.utils#read-all (#!optional (or input-port string)) string)) +(chicken.utils#system* (#(procedure #:clean #:enforce) chicken.utils#system* (string #!rest) undefined)) +(chicken.utils#qs (#(procedure #:clean #:enforce) chicken.utils#qs (string) string)) +(chicken.utils#compile-file (#(procedure #:clean #:enforce) chicken.utils#compile-file (string #!rest) (or false string))) +(chicken.utils#compile-file-options (#(procedure #:clean #:enforce) chicken.utils#compile-file-options (#!optional (list-of string)) (list-of string))) +(chicken.utils#scan-input-lines (#(procedure #:enforce) chicken.utils#scan-input-lines (* #!optional input-port) *)) +(chicken.utils#yes-or-no? (#(procedure #:enforce) chicken.utils#yes-or-no? (string #!rest) *)) diff --git a/utils.import.scm b/utils.import.scm deleted file mode 100644 index a992b40..0000000 --- a/utils.import.scm +++ /dev/null @@ -1,35 +0,0 @@ -;;;; utils.import.scm - import library for "utils" module -; -; Copyright (c) 2008-2014, The CHICKEN Team -; All rights reserved. -; -; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following -; conditions are met: -; -; Redistributions of source code must retain the above copyright notice, this list of conditions and the following -; disclaimer. -; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following -; disclaimer in the documentation and/or other materials provided with the distribution. -; Neither the name of the author nor the names of its contributors may be used to endorse or promote -; products derived from this software without specific prior written permission. -; -; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS -; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR -; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -; POSSIBILITY OF SUCH DAMAGE. - - -(##sys#register-primitive-module - 'utils - '(read-all - system* - qs - compile-file - compile-file-options - scan-input-lines - yes-or-no?)) diff --git a/utils.scm b/utils.scm index cedd952..0e6400c 100644 --- a/utils.scm +++ b/utils.scm @@ -31,6 +31,23 @@ (fixnum) (disable-interrupts) ) +(module chicken.utils + (compile-file + compile-file-options + read-all + scan-input-lines + system* + yes-or-no? + qs) + +(import scheme chicken) +(import chicken.data-structures + chicken.extras + chicken.files + chicken.foreign + chicken.posix + chicken.irregex) + (include "common-declarations.scm") (register-feature! 'utils) @@ -200,4 +217,5 @@ C_confirmation_dialog(char *msg, char *caption, int def, int abort) { return -1; (printf "~%Please enter \"yes\", \"no\" or \"abort\".~%") (printf "~%Please enter \"yes\" or \"no\".~%")) (loop) ) ) ) ) ) ) ) ) - + +) -- 2.1.4