~ chicken-core (chicken-5) 7eaf4dea757b5e9db7e4af98c5e36593ad7589d1
commit 7eaf4dea757b5e9db7e4af98c5e36593ad7589d1
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri May 14 23:45:27 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri May 14 23:45:27 2010 +0200
cleaned up declarations and moved them into common file; fixed wrongly named constant reference in srfi-69.scm
diff --git a/common-declarations.scm b/common-declarations.scm
new file mode 100644
index 00000000..4b197173
--- /dev/null
+++ b/common-declarations.scm
@@ -0,0 +1,51 @@
+;;;; common-declarations.scm - settings for core libraries
+;
+; Copyright (c) 2008-2010, 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.
+
+
+(declare
+ (disable-warning var redef)
+ (usual-integrations)
+ (hide d))
+
+(cond-expand
+ (debugbuild
+ (define (d arg1 . more)
+ (when (##sys#fudge 13)
+ (if (null? more)
+ (pp arg1)
+ (apply print arg1 more)))))
+ (else
+ (declare
+ (no-bound-checks)
+ (no-procedure-checks-for-toplevel-bindings))
+ (define-syntax d (syntax-rules () ((_ . _) (void))))))
+
+(define-syntax define-alias
+ (syntax-rules ()
+ ((_ new old)
+ (define-syntax new
+ (syntax-rules ___ ()
+ ((_ args ___)
+ (old args ___)))))))
diff --git a/compiler.scm b/compiler.scm
index feeec278..b2557671 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1425,7 +1425,7 @@
(cond ((null? (cdr spec))
(set! profiled-procedures 'all) )
(else
- (set! profiled-propcedures 'some)
+ (set! profiled-procedures 'some)
(for-each
(cut mark-variable <> '##compiler#profile)
(stripa (cdr spec))))))
@@ -1917,7 +1917,7 @@
(when (and (not (variable-visible? sym))
(not (variable-mark sym '##compiler#constant)) )
(##sys#notice
- (sprintf "global variable `~S' is never used" sym) ) ) )
+ (sprintf "global variable `~S' is only locally visible and never used" sym) ) ) )
;; Make 'boxed, if 'assigned & 'captured:
(when (and assigned captured)
diff --git a/data-structures.scm b/data-structures.scm
index 061a887b..da1e3a2a 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -27,47 +27,12 @@
(declare
(unit data-structures)
- (usual-integrations)
- (disable-warning redef)
(foreign-declare #<<EOF
#define C_mem_compare(to, from, n) C_fix(C_memcmp(C_c_string(to), C_c_string(from), C_unfix(n)))
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-char ##sys#check-exact ##sys#check-port ##sys#check-string
- ##sys#substring ##sys#for-each ##sys#map ##sys#setslot
- ##sys#allocate-vector ##sys#check-pair ##sys#error-not-a-proper-list
- ##sys#member ##sys#assoc ##sys#error ##sys#signal-hook ##sys#read-string!
- ##sys#check-symbol ##sys#check-vector
- ##sys#check-number
- ##sys#flonum-fraction ##sys#make-port ##sys#fetch-and-check-port-arg
- ##sys#print ##sys#check-structure ##sys#make-structure make-parameter
- ##sys#flush-output ##sys#write-char-0 ##sys#number->string
- ##sys#fragments->string ##sys#symbol->qualified-string
- ##sys#number? ##sys#procedure->string
- ##sys#pointer->string ##sys#user-print-hook ##sys#peek-char-0
- ##sys#read-char-0 ##sys#write-char ##sys#string-append ##sys#gcd ##sys#lcm
- ##sys#fudge ##sys#check-list ##sys#user-read-hook ##sys#check-closure ##sys#check-inexact
- input-port? make-vector list->vector sort! merge! open-output-string floor
- get-output-string current-output-port display write port? list->string
- make-string string pretty-print-width newline char-name read random
- open-input-string make-string call-with-input-file read-line reverse ) ) ] )
-
-(private data-structures
- fprintf0 generic-write )
-
-(declare
- (hide
- fprintf0 generic-write ) )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'data-structures)
diff --git a/defaults.make b/defaults.make
index a1da1852..1739b1a3 100644
--- a/defaults.make
+++ b/defaults.make
@@ -300,7 +300,6 @@ CHICKEN_OPTIONS += $(EXTRA_CHICKEN_OPTIONS)
CHICKEN_LIBRARY_OPTIONS = $(CHICKEN_OPTIONS) -explicit-use -no-trace
CHICKEN_PROGRAM_OPTIONS = $(CHICKEN_OPTIONS) -no-lambda-info -local
CHICKEN_COMPILER_OPTIONS = $(CHICKEN_PROGRAM_OPTIONS) -extend private-namespace.scm
-CHICKEN_UNSAFE_OPTIONS = -unsafe -no-lambda-info
CHICKEN_DYNAMIC_OPTIONS = $(CHICKEN_OPTIONS) -feature chicken-compile-shared -dynamic
CHICKEN_IMPORT_LIBRARY_OPTIONS = $(CHICKEN_DYNAMIC_OPTIONS) -no-trace
diff --git a/distribution/manifest b/distribution/manifest
index d0543f86..75be8611 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -184,7 +184,7 @@ expand.scm
expand.c
chicken-syntax.scm
chicken-syntax.c
-unsafe-declarations.scm
+common-declarations.scm
ports.import.scm
ports.import.c
files.import.scm
diff --git a/eval.scm b/eval.scm
index 36a9b31a..e78d7e9e 100644
--- a/eval.scm
+++ b/eval.scm
@@ -28,20 +28,12 @@
(declare
(unit eval)
(uses expand)
- (disable-warning var)
(hide ##sys#r4rs-environment ##sys#r5rs-environment
##sys#interaction-environment pds pdss pxss d)
(not inline ##sys#repl-eval-hook ##sys#repl-read-hook ##sys#repl-print-hook
##sys#read-prompt-hook ##sys#alias-global-hook ##sys#user-read-hook
##sys#syntax-error-hook))
-(define (d arg1 . more)
- (if (null? more)
- (pp arg1)
- (apply print arg1 more)))
-
-(define-syntax d (syntax-rules () ((_ . _) (void))))
-
#>
#ifndef C_INSTALL_EGG_HOME
# define C_INSTALL_EGG_HOME "."
@@ -56,48 +48,7 @@
#endif
<#
-(cond-expand
- [paranoia]
- [else
- (declare
- ;***(no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-char ##sys#check-exact ##sys#check-port ##sys#check-string ##sys#load-library
- ##sys#load-library-0
- ##sys#for-each ##sys#map ##sys#setslot ##sys#allocate-vector ##sys#check-pair ##sys#error-not-a-proper-list
- ##sys#check-symbol ##sys#check-vector
- ##sys#check-number ##sys#copy-env-table
- ##sys#flonum-fraction ##sys#make-port ##sys#fetch-and-check-port-arg ##sys#print ##sys#check-structure
- ##sys#make-structure ##sys#feature?
- ##sys#error-handler ##sys#hash-symbol ##sys#check-syntax
- ##sys#hash-table-ref ##sys#hash-table-set! ##sys#canonicalize-body ##sys#decompose-lambda-list
- ##sys#make-c-string ##sys#resolve-include-filename
- ##sys#load ##sys#error ##sys#warn ##sys#hash-table-location ##sys#expand-home-path
- ##sys#make-flonum ##sys#make-pointer ##sys#null-pointer ##sys#address->pointer
- ##sys#pointer->address ##sys#compile-to-closure ##sys#make-string ##sys#make-lambda-info
- ##sys#number? ##sys#symbol->qualified-string ##sys#decorate-lambda ##sys#string-append
- ##sys#ensure-heap-reserve ##sys#syntax-error-hook ##sys#read-prompt-hook
- ##sys#repl-eval-hook ##sys#append ##sys#eval-decorator
- open-output-string get-output-string make-parameter software-type software-version machine-type
- build-platform ##sys#string->symbol list->vector get-environment-variable
- extension-information syntax-error ->string chicken-home ##sys#expand-curried-define
- vector->list store-string open-input-string eval ##sys#gc
- with-exception-handler print-error-message read-char read ##sys#read-error
- ##sys#reset-handler call-with-current-continuation ##sys#peek-char-0 ##sys#read-char-0
- ##sys#clear-trace-buffer ##sys#write-char-0 print-call-chain ##sys#with-print-length-limit
- repl-prompt ##sys#flush-output ##sys#extended-lambda-list? keyword? get-line-number
- symbol->string string-append display ##sys#repository-path ##sys#file-info make-vector
- ##sys#make-vector string-copy vector->list ##sys#do-the-right-thing ##sys#->feature-id
- ##sys#extension-information ##sys#symbol->string ##sys#canonicalize-extension-path
- file-exists? ##sys#load-extension ##sys#find-extension ##sys#substring reverse
- dynamic-load-libraries ##sys#string->c-identifier load-verbose ##sys#load ##sys#get-keyword
- port? ##sys#file-info ##sys#signal-hook ##sys#dload open-input-file close-input-port
- read write newline ##sys#eval-handler ##sys#set-dlopen-flags! cadadr ##sys#lookup-runtime-requirements
- map string->keyword ##sys#abort
- ##sys#expand-0) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(define-foreign-variable install-egg-home c-string "C_INSTALL_EGG_HOME")
(define-foreign-variable installation-home c-string "C_INSTALL_SHARE_HOME")
diff --git a/expand.scm b/expand.scm
index 1dc1e934..d95bd4ae 100644
--- a/expand.scm
+++ b/expand.scm
@@ -35,31 +35,14 @@
(not inline ##sys#syntax-error-hook ##sys#compiler-syntax-hook
##sys#alias-global-hook ##sys#toplevel-definition-hook))
+(include "common-declarations.scm")
(set! ##sys#features
(append '(#:hygienic-macros #:syntax-rules) ##sys#features))
-(define (d arg1 . more)
- (when (##sys#fudge 13)
- (if (null? more)
- (pp arg1)
- (apply print arg1 more))) )
-
-(define dd d)
-(define dm d)
-(define dx d)
-
-(cond-expand
- ((not debugbuild)
- (declare
- (no-bound-checks)
- (no-procedure-checks)))
- (else))
-
-(begin
- (define-syntax dd (syntax-rules () ((_ . _) (void))))
- (define-syntax dm (syntax-rules () ((_ . _) (void))))
- (define-syntax dx (syntax-rules () ((_ . _) (void)))) )
+(define-alias dd d)
+(define-alias dm d)
+(define-alias dx d)
(define-inline (getp sym prop)
(##core#inline "C_i_getprop" sym prop #f))
diff --git a/extras.scm b/extras.scm
index 3782c883..26e5db04 100644
--- a/extras.scm
+++ b/extras.scm
@@ -27,40 +27,12 @@
(declare
(unit extras)
- (uses data-structures ports)
- (usual-integrations)
- (disable-warning redef) )
-
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-char ##sys#check-exact ##sys#check-port ##sys#check-string
- ##sys#substring ##sys#for-each ##sys#map ##sys#setslot
- ##sys#allocate-vector ##sys#check-pair ##sys#error-not-a-proper-list
- ##sys#member ##sys#assoc ##sys#error ##sys#signal-hook ##sys#read-string!
- ##sys#check-symbol ##sys#check-vector##sys#check-number
- ##sys#flonum-fraction ##sys#make-port ##sys#fetch-and-check-port-arg
- ##sys#print ##sys#check-structure ##sys#make-structure make-parameter
- ##sys#flush-output ##sys#write-char-0 ##sys#number->string
- ##sys#fragments->string ##sys#symbol->qualified-string
- ##sys#number? ##sys#procedure->string
- ##sys#pointer->string ##sys#user-print-hook ##sys#peek-char-0
- ##sys#read-char-0 ##sys#write-char ##sys#string-append ##sys#gcd ##sys#lcm
- ##sys#fudge ##sys#check-list ##sys#user-read-hook ##sys#check-closure ##sys#check-inexact
- input-port? make-vector list->vector sort! merge! open-output-string floor
- get-output-string current-output-port display write port? list->string
- make-string string pretty-print-width newline char-name read random
- open-input-string make-string call-with-input-file read-line reverse ) ) ] )
+ (uses data-structures ports))
(declare
- (hide
- fprintf0 generic-write) )
+ (hide fprintf0 generic-write) )
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'extras)
diff --git a/files.scm b/files.scm
index 5d6c8d59..4ff312e3 100644
--- a/files.scm
+++ b/files.scm
@@ -37,7 +37,6 @@
(declare
(unit files)
(uses regex data-structures)
- (usual-integrations)
(fixnum)
(hide chop-pds absolute-pathname-root root-origin root-directory split-directory)
(disable-interrupts)
@@ -54,22 +53,7 @@
EOF
))
-(cond-expand
- [paranoia]
- [else
- (declare
- (always-bound
- ##sys#windows-platform)
- (bound-to-procedure
- string-match regexp
- ##sys#string-append ##sys#substring string-append
- get-environment-variable
- file-exists? delete-file
- call-with-output-file read-string)
- (no-procedure-checks-for-usual-bindings)
- (no-bound-checks))] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'files)
diff --git a/library.scm b/library.scm
index d93373e3..275582fe 100644
--- a/library.scm
+++ b/library.scm
@@ -28,8 +28,6 @@
(declare
(unit library)
(disable-interrupts)
- (disable-warning var redef)
- (usual-integrations)
(hide ##sys#dynamic-unwind ##sys#find-symbol
##sys#grow-vector ##sys#default-parameter-vector
print-length-limit current-print-length setter-tag read-marks
@@ -129,53 +127,8 @@ fast_read_string_from_file (C_word dest, C_word port, C_word len, C_word pos)
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-char ##sys#check-exact ##sys#check-port ##sys#check-port* ##sys#check-string ##sys#substring ##sys#check-port-mode
- ##sys#for-each ##sys#map ##sys#setslot ##sys#allocate-vector ##sys#check-pair
- ##sys#error-not-a-proper-list ##sys#error ##sys#warn ##sys#signal-hook
- ##sys#check-symbol ##sys#check-vector
- ##sys#check-number ##sys#check-integer ##sys#check-special
- ##sys#flonum-fraction ##sys#make-port ##sys#print
- ##sys#check-structure ##sys#make-structure ##sys#procedure->string
- ##sys#gcd ##sys#lcm ##sys#ensure-heap-reserve ##sys#check-list
- ##sys#enable-interrupts ##sys#disable-interrupts ##sys#->feature-id
- ##sys#fudge ##sys#user-read-hook ##sys#check-range ##sys#read
- ##sys#string->symbol ##sys#symbol->string ##sys#dynamic-unwind ##sys#pathname-resolution
- ##sys#platform-fixup-pathname ##sys#expand-home-path ##sys#string-append ##sys#symbol->qualified-string
- ##sys#error-handler ##sys#signal ##sys#abort ##sys#port-data ##sys#set-port-data!
- ##sys#reset-handler ##sys#exit-handler ##sys#dynamic-wind ##sys#port-line
- ##sys#grow-vector ##sys#run-pending-finalizers ##sys#peek-char-0 ##sys#read-char-0
- ##sys#read-char/port ##sys#write-char/port
- ##sys#schedule ##sys#make-thread ##sys#print-to-string ##sys#scan-buffer-line
- ##sys#update-thread-state-buffer ##sys#restore-thread-state-buffer ##sys#user-print-hook
- ##sys#current-exception-handler ##sys#default-exception-handler ##sys#abandon-mutexes ##sys#make-mutex
- ##sys#port-has-file-pointer? ##sys#infix-list-hook char-name ##sys#open-file-port make-parameter
- ##sys#intern-symbol ##sys#make-string ##sys#number? software-type build-platform
- open-output-string get-output-string print-call-chain ##sys#symbol-has-toplevel-binding? repl
- argv condition-property-accessor ##sys#decorate-lambda ##sys#become! ##sys#lambda-decoration
- getter-with-setter ##sys#lambda-info ##sys#lambda-info->string open-input-string ##sys#gc
- ##sys#memory-info ##sys#make-c-string ##sys#find-symbol-table display
- newline string-append ##sys#with-print-length-limit write print vector-fill! ##sys#context-switch
- ##sys#set-finalizer! open-output-string get-output-string read ##sys#make-pointer
- ##sys#pointer->address number->string ##sys#flush-output
- ##sys#apply-values ##sys#get-call-chain ##sys#really-print-call-chain
- string->keyword keyword? string->keyword get-environment-variable ##sys#number->string ##sys#copy-bytes
- call-with-current-continuation ##sys#string->number ##sys#inexact->exact ##sys#exact->inexact
- ##sys#reverse-list->string reverse ##sys#inexact? list? string ##sys#char->utf8-string
- ##sys#unicode-surrogate? ##sys#surrogates->codepoint ##sys#write-char/port
- ##sys#update-errno ##sys#file-info close-output-port close-input-port ##sys#peek-unsigned-integer
- continuation-graft char-downcase string-copy remainder floor ##sys#exact? list->string
- ##sys#append ##sys#list ##sys#cons ##sys#list->vector ##sys#apply ##sys#make-vector
- ##sys#write-char ##sys#force-finalizers ##sys#cleanup-before-exit ##sys#write-char-0
- ##sys#default-read-info-hook ##sys#read-error) ) ] )
-
+(include "common-declarations.scm")
(include "version.scm")
(include "banner.scm")
@@ -355,8 +308,6 @@ EOF
(##core#inline "C_i_check_closure_2" x (car loc))
(##core#inline "C_i_check_closure" x) ) )
-(include "unsafe-declarations.scm")
-
(define (##sys#force promise)
(if (##sys#structure? promise 'promise)
((##sys#slot promise 1))
diff --git a/lolevel.scm b/lolevel.scm
index 1074d50f..0d0346ba 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -28,8 +28,6 @@
(declare
(unit lolevel)
(uses srfi-69)
- (usual-integrations)
- (disable-warning var redef)
(hide ipc-hook-0 *set-invalid-procedure-call-handler! xproc-tag
##sys#check-block
##sys#check-become-alist
@@ -49,27 +47,7 @@
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-pointer ##sys#check-closure ##sys#check-integer ##sys#check-special
- ##sys#error ##sys#signal-hook ##sys#error-hook
- ##sys#error-not-a-proper-list
- make-hash-table hash-table-ref/default hash-table-set!
- ##sys#make-pointer ##sys#make-tagged-pointer ##sys#make-locative ##sys#locative?
- ##sys#become!
- ##sys#make-string ##sys#make-vector ##sys#vector->closure!
- make-property-condition make-composite-condition signal
- ##sys#generic-structure?
- ##sys#set-pointer-address! ##sys#address->pointer ##sys#pointer->address
- ##sys#lambda-decoration ##sys#decorate-lambda
- extend-procedure ) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'lolevel)
diff --git a/ports.scm b/ports.scm
index 81545344..6847a8b7 100644
--- a/ports.scm
+++ b/ports.scm
@@ -10,12 +10,10 @@
;
; 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.
@@ -35,38 +33,9 @@
(declare
- (unit ports)
-; (uses data-structures)
- (usual-integrations)
- (disable-warning redef) )
-
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-char ##sys#check-exact ##sys#check-port ##sys#check-string
- ##sys#substring ##sys#for-each ##sys#map ##sys#setslot
- ##sys#allocate-vector ##sys#check-pair ##sys#error-not-a-proper-list
- ##sys#member ##sys#assoc ##sys#error ##sys#signal-hook ##sys#read-string!
- ##sys#check-symbol ##sys#check-vector ##sys#check-number
- ##sys#flonum-fraction ##sys#make-port ##sys#fetch-and-check-port-arg
- ##sys#print ##sys#check-structure ##sys#make-structure make-parameter
- ##sys#flush-output ##sys#write-char-0 ##sys#number->string
- ##sys#fragments->string ##sys#symbol->qualified-string
- ##sys#number? ##sys#procedure->string
- ##sys#pointer->string ##sys#user-print-hook ##sys#peek-char-0
- ##sys#read-char-0 ##sys#write-char ##sys#string-append ##sys#gcd ##sys#lcm
- ##sys#fudge ##sys#check-list ##sys#user-read-hook ##sys#check-closure ##sys#check-inexact
- input-port? make-vector list->vector open-output-string floor
- get-output-string current-output-port display write port? list->string
- call-with-input-string with-input-from-string
- make-string string newline char-name read
- open-input-string call-with-input-file reverse ) ) ] )
-
-(include "unsafe-declarations.scm")
+ (unit ports))
+
+(include "common-declarations.scm")
(register-feature! 'ports)
diff --git a/posixunix.scm b/posixunix.scm
index 4682a154..87ffe1ad 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -29,7 +29,6 @@
(unit posix)
(uses scheduler regex extras utils files ports)
(disable-interrupts)
- (usual-integrations)
(hide ##sys#stat group-member _get-groups _ensure-groups posix-error
##sys#terminal-check
check-time-vector)
@@ -488,28 +487,7 @@ static int set_file_mtime(char *filename, C_word tm)
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- string-match glob->regexp regexp
- ##sys#thread-yield! ##sys#make-string
- ##sys#make-port ##sys#file-info ##sys#update-errno ##sys#fudge ##sys#make-c-string ##sys#check-port
- ##sys#error ##sys#signal-hook ##sys#peek-unsigned-integer make-pathname glob directory?
- pathname-file process-fork file-close duplicate-fileno process-execute get-environment-variable
- make-string make-input-port make-output-port ##sys#thread-block-for-i/o create-pipe
- process-wait pathname-strip-directory pathname-directory ##sys#expand-home-path directory
- decompose-pathname ##sys#decode-seconds ##sys#null-pointer ##sys#pointer->address
- ##sys#substring ##sys#context-switch close-input-pipe close-output-pipe change-directory
- current-directory ##sys#make-pointer port? ##sys#schedule ##sys#process
- ##sys#peek-fixnum ##sys#make-structure ##sys#check-structure ##sys#enable-interrupts
- make-nonblocking-input-port make-nonblocking-output-port
- canonical-path) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'posix)
diff --git a/posixwin.scm b/posixwin.scm
index 75e53cc9..4cb9461e 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -65,7 +65,6 @@
(unit posix)
(uses scheduler regex extras utils files ports)
(disable-interrupts)
- (usual-integrations)
(hide ##sys#stat posix-error
$quote-args-list $exec-setup $exec-teardown
check-time-vector)
@@ -921,18 +920,7 @@ static int set_file_mtime(char *filename, C_word tm)
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#make-port ##sys#file-info ##sys#update-errno ##sys#fudge ##sys#make-c-string ##sys#check-port
- ##sys#error ##sys#signal-hook ##sys#peek-unsigned-integer ##sys#process
- ##sys#peek-fixnum ##sys#make-structure ##sys#check-structure ##sys#enable-interrupts) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'posix)
diff --git a/profiler.scm b/profiler.scm
index 097cdd87..c118c4bc 100644
--- a/profiler.scm
+++ b/profiler.scm
@@ -27,19 +27,10 @@
(declare
(unit profiler)
- (usual-integrations)
(hide ##sys#profile-name ##sys#profile-vector-list)
(disable-interrupts)
(fixnum-arithmetic) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (bound-to-procedure
- write-char write make-vector)
- (no-bound-checks) ) ] )
-
(foreign-declare #<<EOF
#if !defined(_MSC_VER)
# include <unistd.h>
@@ -47,6 +38,8 @@
EOF
)
+(include "common-declarations.scm")
+
(define-foreign-variable profile-id int "getpid()")
(define-constant profile-info-entry-size 5)
diff --git a/regex.scm b/regex.scm
index 494c4702..3494781c 100644
--- a/regex.scm
+++ b/regex.scm
@@ -25,12 +25,9 @@
; POSSIBILITY OF SUCH DAMAGE.
-(cond-expand
- [chicken-compile-shared]
- [else (declare (unit regex))] )
+(declare (unit regex))
(declare
- (usual-integrations)
(disable-interrupts)
; (disable-warning var)
(fixnum)
@@ -53,14 +50,7 @@
irregex-nfa irregex-flags irregex-submatches irregex-lengths irregex-names
))
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'regex 'irregex)
diff --git a/rules.make b/rules.make
index 92108392..0dd37245 100644
--- a/rules.make
+++ b/rules.make
@@ -824,53 +824,53 @@ endif
setup-api.import.scm: setup-api.c
setup-download.import.scm: setup-download.c
-library.c: $(SRCDIR)library.scm $(SRCDIR)version.scm $(SRCDIR)banner.scm
+library.c: $(SRCDIR)library.scm $(SRCDIR)version.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-eval.c: $(SRCDIR)eval.scm
+eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm
+expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-chicken-syntax.c: $(SRCDIR)chicken-syntax.scm
+chicken-syntax.c: $(SRCDIR)chicken-syntax.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-chicken-ffi-syntax.c: $(SRCDIR)chicken-ffi-syntax.scm
+chicken-ffi-syntax.c: $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-data-structures.c: $(SRCDIR)data-structures.scm $(SRCDIR)private-namespace.scm
- $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ -extend $(SRCDIR)private-namespace.scm
-ports.c: $(SRCDIR)ports.scm $(SRCDIR)private-namespace.scm
- $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ -extend $(SRCDIR)private-namespace.scm
-files.c: $(SRCDIR)files.scm $(SRCDIR)private-namespace.scm
- $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ -extend $(SRCDIR)private-namespace.scm
-extras.c: $(SRCDIR)extras.scm $(SRCDIR)private-namespace.scm
- $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ -extend $(SRCDIR)private-namespace.scm
-lolevel.c: $(SRCDIR)lolevel.scm
+data-structures.c: $(SRCDIR)data-structures.scm $(SRCDIR)common-declarations.scm
+ $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
+ports.c: $(SRCDIR)ports.scm $(SRCDIR)common-declarations.scm
+ $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
+files.c: $(SRCDIR)files.scm $(SRCDIR)common-declarations.scm
+ $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
+extras.c: $(SRCDIR)extras.scm $(SRCDIR)private-namespace.scm $(SRCDIR)common-declarations.scm
+ $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
+lolevel.c: $(SRCDIR)lolevel.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-tcp.c: $(SRCDIR)tcp.scm
+tcp.c: $(SRCDIR)tcp.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-srfi-1.c: $(SRCDIR)srfi-1.scm
+srfi-1.c: $(SRCDIR)srfi-1.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-srfi-4.c: $(SRCDIR)srfi-4.scm
+srfi-4.c: $(SRCDIR)srfi-4.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-srfi-13.c: $(SRCDIR)srfi-13.scm
+srfi-13.c: $(SRCDIR)srfi-13.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-srfi-14.c: $(SRCDIR)srfi-14.scm
+srfi-14.c: $(SRCDIR)srfi-14.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-srfi-18.c: $(SRCDIR)srfi-18.scm
+srfi-18.c: $(SRCDIR)srfi-18.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-srfi-69.c: $(SRCDIR)srfi-69.scm $(SRCDIR)private-namespace.scm
+srfi-69.c: $(SRCDIR)srfi-69.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ -extend $(SRCDIR)private-namespace.scm
-utils.c: $(SRCDIR)utils.scm
+utils.c: $(SRCDIR)utils.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-posixunix.c: $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm
+posixunix.c: $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-posixwin.c: $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm
+posixwin.c: $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-regex.c: $(SRCDIR)regex.scm $(SRCDIR)irregex.scm
+regex.c: $(SRCDIR)regex.scm $(SRCDIR)irregex.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-scheduler.c: $(SRCDIR)scheduler.scm
+scheduler.c: $(SRCDIR)scheduler.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-profiler.c: $(SRCDIR)profiler.scm
+profiler.c: $(SRCDIR)profiler.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-stub.c: $(SRCDIR)stub.scm
+stub.c: $(SRCDIR)stub.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
chicken.import.c: $(SRCDIR)chicken.import.scm
@@ -1095,4 +1095,4 @@ buildhead:
rm -fr chicken-`cat buildversion`
git archive --format=tar --prefix=chicken-`cat buildversion`/ HEAD | tar x
cd chicken-`cat buildversion`; $(MAKE) -f Makefile.$(PLATFORM) \
- PLATFORM=$(PLATFORM) PREFIX=`pwd` CONFIG= CHICKEN=../$(CHICKEN) all install
+ PLATFORM=$(PLATFORM) PREFIX=`pwd` CONFIG= CHICKEN=$(CHICKEN) all install
diff --git a/scheduler.scm b/scheduler.scm
index b03e3b2d..4e868075 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -26,11 +26,9 @@
(declare
- (fixnum)
(unit scheduler)
+ (fixnum)
(disable-interrupts)
- (usual-integrations)
- (disable-warning var)
(hide ##sys#ready-queue-head ##sys#ready-queue-tail ##sys#timeout-list
##sys#update-thread-state-buffer ##sys#restore-thread-state-buffer
##sys#remove-from-ready-queue ##sys#unblock-threads-for-i/o ##sys#force-primordial
@@ -81,17 +79,14 @@ static fd_set C_fdset_input, C_fdset_output, C_fdset_input_2, C_fdset_output_2;
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare (unsafe)) ] )
+(declare (unsafe))
+(include "common-declarations.scm")
(define-syntax dbg
(syntax-rules ()
((_ . _) #f)))
-
(define (##sys#schedule)
(define (switch thread)
(dbg "switching to " thread)
diff --git a/srfi-1.scm b/srfi-1.scm
index 579b49e2..ec33df82 100644
--- a/srfi-1.scm
+++ b/srfi-1.scm
@@ -10,37 +10,9 @@
(disable-warning redef)
(hide ##srfi1#cars+cdrs/no-test ##srfi1#cdrs ##srfi1#cars+ ##srfi1#really-append-map ##srfi1#cars+cdrs+
##srfi1#cars+cdrs ##srfi1#lset2<=)
- (extended-bindings)
- (standard-bindings not boolean? apply call-with-current-continuation eq? eqv? equal? pair? cons car cdr caar cadr
- cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar
- cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr set-car! set-cdr!
- null? list list? length zero? * - error + / - > < >= <= current-output-port current-input-port
- write-char newline write display append symbol->string char? char->integer
- integer->char eof-object? vector-length string-length string-ref string-set! vector-ref
- vector-set! char=? char<? char>? char>=? char<=? gcd lcm reverse symbol? string->symbol
- number? complex? real? integer? rational? odd? even? positive? negative? exact? inexact?
- max min quotient remainder modulo floor ceiling truncate round exact->inexact inexact->exact
- exp log sin expt sqrt cos tan asin acos atan number->string string->number char-ci=?
- char-ci<? char-ci>? char-ci>=? char-ci<=? char-alphabetic? char-whitespace? char-numeric?
- char-lower-case? char-upper-case? char-upcase char-downcase string? string=? string>? string<?
- string>=? string<=? string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?
- string-append string->list list->string vector? vector->list list->vector string read
- read-char substring string-fill! vector-fill! make-string make-vector open-input-file
- open-output-file call-with-input-file call-with-output-file close-input-port close-output-port
- port? values call-with-values vector procedure? memq memv assq assv) )
-
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- every any partition! reduce lset-difference! append! pair-fold lset-diff+intersection! fold
- lset-difference filter! filter delete span! span find-tail find delete! pair-for-each car+cdr
- reduce-right last-pair drop)
- (no-bound-checks) ) ] )
-
-(include "unsafe-declarations.scm")
+ (not standard-bindings member assoc))
+
+(include "common-declarations.scm")
(register-feature! 'srfi-1)
diff --git a/srfi-13.scm b/srfi-13.scm
index 14c12337..615cbb75 100644
--- a/srfi-13.scm
+++ b/srfi-13.scm
@@ -5,46 +5,15 @@
(unit srfi-13)
(uses srfi-14)
(fixnum)
- (disable-warning redef)
(hide %string-prefix? %string-hash %finish-string-concatenate-reverse %string-suffix-length %string-prefix-length
%string-map %string-copy! %string-compare %substring/shared %string-suffix? %multispan-repcopy!
%string-prefix-length-ci %string-suffix-length-ci %string-prefix-ci? %string-suffix-ci?
##srfi13#traverse
%string-titlecase! %string-map! %string-compare-ci ##srfi13#string-fill!)
- (standard-bindings not boolean? apply call-with-current-continuation eq? eqv? equal? pair? cons car cdr caar cadr
- cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar
- cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr set-car! set-cdr!
- null? list list? length zero? * - error + / - > < >= <= current-output-port current-input-port
- write-char newline write display append symbol->string char? char->integer
- integer->char eof-object? vector-length string-length string-ref string-set! vector-ref
- vector-set! char=? char<? char>? char>=? char<=? gcd lcm reverse symbol? string->symbol
- number? complex? real? integer? rational? odd? even? positive? negative? exact? inexact?
- max min quotient remainder modulo floor ceiling truncate round exact->inexact inexact->exact
- exp log sin expt sqrt cos tan asin acos atan number->string string->number char-ci=?
- char-ci<? char-ci>? char-ci>=? char-ci<=? char-alphabetic? char-whitespace? char-numeric?
- char-lower-case? char-upper-case? char-upcase char-downcase string? string=? string>? string<?
- string>=? string<=? string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?
- string-append list->string vector? vector->list list->vector string read map for-each
- read-char substring vector-fill! make-string make-vector open-input-file
- open-output-file call-with-input-file call-with-output-file close-input-port close-output-port
- port? values call-with-values vector procedure? memq memv assq assv member assoc)
- (extended-bindings)
+ (not standard-bindings string-copy string->list string-fill!)
(disable-interrupts) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- string-concatenate check-substring-spec ##srfi13#string-fill! string-parse-final-start+end
- ##sys#substring string-index-right string-skip-right substring/shared
- string-concatenate/shared make-kmp-restart-vector string-ci= string= char-set?
- char-set-contains? string-fold char-set string-skip string-index string-downcase! char->int
- string-parse-start+end substring-spec-ok?)
- (no-bound-checks) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'srfi-13)
diff --git a/srfi-14.scm b/srfi-14.scm
index f394288e..a1f6c13c 100644
--- a/srfi-14.scm
+++ b/srfi-14.scm
@@ -5,25 +5,12 @@
(unit srfi-14)
(fixnum)
(disable-interrupts)
- (standard-bindings)
- (extended-bindings)
(hide %char-set:s/check %string-iter %char-set-diff+intersection! %char->latin1 %latin1->char
%ucs-range->char-set! %string->char-set! %list->char-set! %set-char-set! %char-set-unfold!
%char-set-algebra %char-set-cursor-next %char-set-filter! %set-char-set c0 c1 %string-copy
%default-base) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- char-set char-set-complement ucs-range->char-set! ucs-range->char-set char-set-union
- char-set-adjoin string->char-set list->char-set string-copy make-char-set char-set-copy
- char-set? char-set-size char-set:s)
- (no-bound-checks) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'srfi-14)
diff --git a/srfi-18.scm b/srfi-18.scm
index 43c0cf51..2c247641 100644
--- a/srfi-18.scm
+++ b/srfi-18.scm
@@ -28,29 +28,10 @@
(declare
(unit srfi-18)
(uses scheduler)
- (disable-warning redef)
(disable-interrupts)
- (usual-integrations)
(hide ##sys#compute-time-limit) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#thread-yield!
- condition-property-accessor ##sys#tty-port? ##sys#thread-block-for-i/o thread-yield! ##sys#thread-unblock!
- ##sys#thread-basic-unblock! gensym ##sys#thread-block-for-timeout! ##sys#thread-kill!
- ##sys#thread-block-for-termination! make-thread ##sys#exact->inexact ##sys#flonum-fraction truncate
- ##sys#add-to-ready-queue
- ##sys#schedule ##sys#make-thread
- ##sys#check-number ##sys#error ##sys#signal-hook ##sys#signal
- ##sys#current-exception-handler ##sys#abandon-mutexes ##sys#check-structure ##sys#structure? ##sys#make-mutex
- ##sys#delq ##sys#compute-time-limit ##sys#fudge) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'srfi-18)
diff --git a/srfi-4.scm b/srfi-4.scm
index 024ea007..3fd10347 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -28,8 +28,6 @@
(declare
(unit srfi-4)
(disable-interrupts)
- (disable-warning redef)
- (usual-integrations)
(hide ##sys#u8vector-set! ##sys#s8vector-set! ##sys#u16vector-set! ##sys#s16vector-set!
##sys#u32vector-set! ##sys#s32vector-set! ##sys#f32vector-set! ##sys#f64vector-set!
##sys#u8vector-ref ##sys#s8vector-ref ##sys#u16vector-ref ##sys#s16vector-ref subvector
@@ -61,24 +59,7 @@
EOF
) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##sys#check-exact ##sys#u8vector-ref ##sys#u8vector-set! ##sys#s8vector-ref ##sys#s8vector-set!
- ##sys#u16vector-ref ##sys#u16vector-set!
- ##sys#s16vector-ref ##sys#s16vector-set! ##sys#u32vector-ref ##sys#u32vector-set! ##sys#s32vector-ref
- ##sys#s32vector-set! read list->f64vector list->s32vector list->u32vector list->u16vector list-s8vector
- list->u8vector set-finalizer!
- ##sys#f32vector-ref ##sys#f32vector-set! ##sys#f64vector-ref ##sys#f64vector-set! ##sys#check-exact-interval
- ##sys#check-inexact-interval ##sys#check-number ##sys#check-structure ##sys#check-list
- ##sys#check-range ##sys#error ##sys#signal-hook
- ##sys#error-not-a-proper-list ##sys#print ##sys#allocate-vector) ) ] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
;;; Helper routines:
diff --git a/srfi-69.scm b/srfi-69.scm
index 88435208..14aac7ea 100644
--- a/srfi-69.scm
+++ b/srfi-69.scm
@@ -26,38 +26,14 @@
(declare
(unit srfi-69)
- (usual-integrations)
- (disable-warning redef) ) ; hash-table-ref is an extended binding!
+ (hide
+ *eq?-hash *eqv?-hash *equal?-hash
+ *make-hash-table
+ *hash-table-copy *hash-table-merge! *hash-table-update!/default
+ *hash-table-for-each *hash-table-fold
+ hash-table-canonical-length hash-table-rehash! hash-table-check-resize! ) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (no-bound-checks)
- (no-procedure-checks-for-usual-bindings) ) ] )
-
-(declare
- (bound-to-procedure
- ##sys#signal-hook
- ##sys#peek-fixnum
- ##sys#make-structure
- ##sys#size
- ##sys#slot ##sys#setslot
- *equal?-hash )
- (hide
- *eq?-hash *eqv?-hash *equal?-hash
- *make-hash-table
- *hash-table-copy *hash-table-merge! *hash-table-update!/default
- *hash-table-for-each *hash-table-fold
- hash-table-canonical-length hash-table-rehash! hash-table-check-resize! ) )
-
-(declare
- (bound-to-procedure
- ##sys#check-string ##sys#check-symbol
- ##sys#check-exact ##sy#check-inexact
- ##sys#check-closure ##sys#check-structure ) )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'srfi-69)
@@ -492,7 +468,7 @@
(##sys#check-exact arg 'make-hash-table)
(unless (fx< 0 arg)
(error 'make-hash-table "invalid size" arg) )
- (set! size (fxmin hash-table-max-size arg))
+ (set! size (fxmin hash-table-max-length arg))
(set! arguments (cdr arguments)) ) ) )
; Process keyword arguments
(let loop ([args arguments])
@@ -517,7 +493,7 @@
(##sys#check-exact val 'make-hash-table)
(unless (fx< 0 val)
(error 'make-hash-table "invalid size" val) )
- (set! size (fxmin hash-table-max-size val))]
+ (set! size (fxmin hash-table-max-length val))]
[(#:initial)
(set! initial (lambda () val))]
[(#:min-load)
diff --git a/tcp.scm b/tcp.scm
index b6e24eb1..4a7f56fc 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -28,20 +28,10 @@
(declare
(unit tcp)
(uses extras scheduler)
- (usual-integrations)
(fixnum-arithmetic)
- (no-bound-checks)
(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)
- (no-procedure-checks-for-usual-bindings)
- (bound-to-procedure
- ##net#socket ##net#bind ##net#connect ##net#listen ##net#accept make-parameter ##sys#string-append ##sys#tcp-port->fileno
- ##sys#check-port ##sys#port-data ##sys#thread-block-for-i/o! make-string make-input-port make-output-port ##sys#substring
- substring ##sys#make-c-string ##sys#schedule ##sys#set-port-data!
- ##net#close ##net#recv ##net#send ##net#select ##net#select-write ##net#gethostaddr ##net#io-ports ##sys#update-errno
- ##sys#error ##sys#signal-hook ##net#getservbyname ##net#parse-host ##net#fresh-addr
- ##net#bind-socket ##net#shutdown)
(foreign-declare #<<EOF
#include <errno.h>
#ifdef _WIN32
@@ -86,7 +76,7 @@ static char addr_buffer[ 20 ];
EOF
) )
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'tcp)
diff --git a/tweaks.scm b/tweaks.scm
index 9a9e6bfc..7a44082a 100644
--- a/tweaks.scm
+++ b/tweaks.scm
@@ -28,19 +28,18 @@
;; This file contains some stuff to speed up basic node accessors, and also
;; contains common declarations.
+
(cond-expand
- [compiler-unsafe
+ (debugbuild
(declare
(fixnum)
+ (disable-interrupts) ))
+ (else
+ (declare
(disable-interrupts)
(no-bound-checks)
(no-procedure-checks)
- (no-argc-checks) ) ]
- [else
- (declare
- (fixnum)
- (disable-interrupts) ) ] )
-
+ (no-argc-checks))))
(define-inline (node? x) (##sys#structure? x 'node))
(define-inline (make-node c p s) (##sys#make-structure 'node c p s))
diff --git a/unsafe-declarations.scm b/unsafe-declarations.scm
deleted file mode 100644
index ffb5b0ae..00000000
--- a/unsafe-declarations.scm
+++ /dev/null
@@ -1,77 +0,0 @@
-;;;; unsafe-declarations.scm - various settings for libraries compiled in unsafe mode
-;
-; Copyright (c) 2008-2010, 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.
-
-
-(cond-expand
- (unsafe
- (define-syntax ##sys#check-closure
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-inexact
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-range
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-pair
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-blob
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-list
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-symbol
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-string
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-char
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-exact
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-port
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-port-mode
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-port*
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-number
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-special
- (syntax-rules ()
- ((_ . _) (##core#undefined))))
- (define-syntax ##sys#check-byte-vector
- (syntax-rules ()
- ((_ . _) '(##core#undefined)) ) ))
- (else))
diff --git a/utils.scm b/utils.scm
index 0d60bd72..318c1f46 100644
--- a/utils.scm
+++ b/utils.scm
@@ -28,26 +28,11 @@
(declare
(unit utils)
(uses extras srfi-13 posix files regex)
- (usual-integrations)
(fixnum)
(hide chop-pds)
(disable-interrupts) )
-(cond-expand
- [paranoia]
- [else
- (declare
- (always-bound
- ##sys#windows-platform)
- (bound-to-procedure
- ##sys#check-port port? read-string read-line with-input-from-file
- command-line-arguments
- string-append
- system)
- (no-procedure-checks-for-usual-bindings)
- (no-bound-checks))] )
-
-(include "unsafe-declarations.scm")
+(include "common-declarations.scm")
(register-feature! 'utils)
Trap