~ chicken-core (chicken-5) 24a2feefaa0a3d807b952fe9441bf1efaf948843

commit 24a2feefaa0a3d807b952fe9441bf1efaf948843
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Mar 23 05:38:02 2011 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Mar 23 05:38:02 2011 -0400

    small rules.make refactoring and test target; types.db fixes

diff --git a/defaults.make b/defaults.make
index 64d91044..b19cca82 100644
--- a/defaults.make
+++ b/defaults.make
@@ -303,7 +303,6 @@ 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 srfi-13 srfi-69 extras srfi-14 tcp foreign scheme srfi-18 utils csi irregex
 IMPORT_LIBRARIES += setup-api setup-download
-SCRUTINIZED_LIBRARIES = library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler profiler stub expand chicken-syntax chicken-ffi-syntax
 
 ifdef STATICBUILD
 CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)$(EXE)
diff --git a/rules.make b/rules.make
index 521a8010..69d14967 100644
--- a/rules.make
+++ b/rules.make
@@ -35,10 +35,11 @@ VPATH=$(SRCDIR)
 
 SETUP_API_OBJECTS_1 = setup-api setup-download
 
-LIBCHICKEN_OBJECTS_1 = \
+LIBCHICKEN_SCHEME_OBJECTS_1 = \
        library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
        srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler \
-       profiler stub expand chicken-syntax chicken-ffi-syntax runtime
+       profiler stub expand chicken-syntax chicken-ffi-syntax
+LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime
 LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
 LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O))
 
@@ -589,8 +590,9 @@ clean:
 	  $(CHICKEN_STATUS_PROGRAM)$(EXE) \
 	  $(CHICKEN_BUG_PROGRAM)$(EXE) *$(O) \
 	  $(LIBCHICKEN_SO_FILE) \
+	  $(PRIMARY_LIBCHICKEN) \
 	  lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX)$(A) \
-	  lib$(PROGRAM_PREFIX)chicken$(PROGRAM_SUFFIX)$(SO) $(PROGRAM_IMPORT_LIBRARIES) \
+	  $(PROGRAM_IMPORT_LIBRARIES) \
 	  $(IMPORT_LIBRARIES:=.import.so) $(LIBCHICKEN_IMPORT_LIBRARY) \
 	  $(SETUP_API_OBJECTS_1:=.so) $(SETUP_API_OBJECTS_1:=.import.so)
 ifdef USES_SONAME
@@ -659,3 +661,17 @@ ifdef WINDOWS_SHELL
 else
 	touch *.scm
 endif
+
+
+# compile all core modules (for testing)
+
+.PHONY: compile-all
+
+COMPILE_ALL_FILES = $(LIBCHICKEN_SCHEME_OBJECTS_1) $(COMPILER_OBJECTS_1)
+
+# use EXTRA_CHICKEN_OPTIONS to test particular compiler options:
+compile-all:
+	@for x in $(COMPILE_ALL_FILES:=.scm); do \
+	  echo "$(CHICKEN) $$x $(CHICKEN_LIBRARY_OPTIONS)"; \
+	  $(CHICKEN) $$x $(CHICKEN_LIBRARY_OPTIONS) -output-file out.c || exit 1; \
+	done
diff --git a/scrutinizer.scm b/scrutinizer.scm
index ef712215..5daffaef 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -37,7 +37,7 @@
   (when (##sys#fudge 13)
     (printf "[debug] ~?~%" fstr args)) )
 
-(define-syntax d (syntax-rules () ((_ . _) (void))))
+;(define-syntax d (syntax-rules () ((_ . _) (void))))
 
 
 ;;; Walk node tree, keeping type and binding information
diff --git a/types.db b/types.db
index bfb3439a..d3efdee8 100644
--- a/types.db
+++ b/types.db
@@ -55,7 +55,7 @@
 
 (pair? (procedure pair? (*) boolean)
        ((pair) (let ((#:tmp #(1))) '#t))
-       (((not pair)) (let ((#:tmp #(1))) '#f)))
+       (((not (or pair list))) (let ((#:tmp #(1))) '#f)))
 
 (cons (procedure cons (* *) pair))
 
@@ -94,8 +94,13 @@
 (set-car! (procedure set-car! (pair *) undefined) ((pair *) (##sys#setslot #(1) '0 #(2))))
 (set-cdr! (procedure set-cdr! (pair *) undefined) ((pair *) (##sys#setslot #(1) '1 #(2))))
 
-(null? (procedure null? (*) boolean) ((null) (let ((#:tmp #(1))) '#t)) ((not null) (let ((#:tmp #(1))) '#f)))
-(list? (procedure list? (*) boolean) (((or null pair list)) (let ((#:tmp #(1))) '#t)) (((not (or null pair list))) (let ((#:tmp #(1))) '#f)))
+(null? (procedure null? (*) boolean)
+       ((null) (let ((#:tmp #(1))) '#t)) ((not null) (let ((#:tmp #(1))) '#f)))
+
+(list? (procedure list? (*) boolean) 
+       (((or null pair list)) (let ((#:tmp #(1))) '#t))
+       (((not (or null pair list))) (let ((#:tmp #(1))) '#f)))
+
 (list (procedure list (#!rest) list))
 (length (procedure length (list) fixnum) ((list) (##core#inline "C_u_i_length" #(1))))
 (list-tail (procedure list-tail (list fixnum) *))
@@ -843,7 +848,7 @@
 
 (atom? (procedure atom? (*) boolean)
        ((pair) (let ((#:tmp #(1))) '#f))
-       (((not pair)) (let ((#:tmp #(1))) '#t)))
+       (((not (or pair list))) (let ((#:tmp #(1))) '#t)))
 
 (binary-search (procedure binary-search (vector (procedure (*) *)) *))
 (butlast (procedure butlast (pair) list))
@@ -1477,7 +1482,7 @@
 
 (not-pair? (procedure not-pair? (*) boolean)
 	   ((pair) (let ((#:tmp #(1))) '#f))
-	   (((not pair)) (let ((#:tmp #(1))) '#t)))
+	   (((not (or pair list))) (let ((#:tmp #(1))) '#t)))
 
 (null-list? (procedure null-list? (list) boolean)
 	    ((pair) (let ((#:tmp #(1))) '#f))