~ chicken-core (chicken-5) e6eb2d2499182816747f9818a2d1a7195be5f659

commit e6eb2d2499182816747f9818a2d1a7195be5f659
Author:     felix <bunny351@gmail.com>
AuthorDate: Mon May 31 11:46:22 2010 +0200
Commit:     felix <bunny351@gmail.com>
CommitDate: Mon May 31 11:46:22 2010 +0200

    added patch by Christian Kellermann to make describe handle circular lists

diff --git a/README b/README
index 0425edd0..b820b435 100644
--- a/README
+++ b/README
@@ -340,11 +340,14 @@
 	release tarball, unpack it, change into the extracted
 	directory and enter
 
-          make PLATFORM=<platform> boot-chicken
+          make PLATFORM=<platform> CHICKEN=<path-to-existing-chicken> \
+            boot-chicken
 
 	This will produce a statically linked binary with the name
 	"chicken-boot[.exe]" that can be given as the value of the
-	"CHICKEN" argument when invoking make(1).
+	"CHICKEN" argument when invoking make(1). Note that the path
+	to an existing `chicken' binary must be given to use it for
+	compiling the Scheme code of the runtime-system and compiler.
 
 
  7. Emacs support
diff --git a/chicken-install.scm b/chicken-install.scm
index faca7081..adc118b0 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -397,7 +397,7 @@
 			   (not (yes-or-no?
 				 (string-append
 				  "You specified `-no-install', but this extension has dependencies"
-				  " that are required for building. Do you still want to install them?")
+				  " that are required for building.\nDo you still want to install them?")
 				 abort: abort-setup)))
 		 (print "aborting installation.")
 		 (cleanup)
diff --git a/csi.scm b/csi.scm
index 4cd15990..bcb10222 100644
--- a/csi.scm
+++ b/csi.scm
@@ -53,7 +53,7 @@ EOF
   (always-bound
     ##sys#windows-platform)
   (hide parse-option-string bytevector-data member* canonicalize-args 
-	describer-table dirseparator?
+	describer-table dirseparator? circular-list?
 	findall command-table) )
 
 
@@ -448,6 +448,15 @@ EOF
     (f32vector "vector of 32-bit floats" f32vector-length f32vector-ref)
     (f64vector "vector of 64-bit floats" f64vector-length f64vector-ref) ) )
 
+(define (circular-list? x)
+  (let lp ((x x) (lag x))
+    (and (pair? x)
+	 (let ((x (cdr x)))
+	   (and (pair? x)
+		(let ((x   (cdr x))
+		      (lag (cdr lag)))
+		  (or (eq? x lag) (lp x lag))))))))
+
 (define-constant max-describe-lines 40)
 
 (define describer-table (make-vector 37 '()))
@@ -524,6 +533,15 @@ EOF
 		    (lambda ()
 		      (write (cadr plist) out) ) )
 		   (newline out) ) ) ) ]
+	    [(circular-list? x)
+	     (fprintf out "circular list: ")
+	     (let loop-print ((x x)
+			      (parsed '()))
+	       (if (not (memq (car x) parsed))
+		   (begin
+		     (fprintf out "~S -> " (car x))
+		     (loop-print (cdr x) (cons (car x) parsed)))
+		   (fprintf out " ~S (circle)~%" (car (memq (car x) parsed)))))]
 	    [(list? x) (descseq "list" length list-ref 0)]
 	    [(pair? x) (fprintf out "pair with car ~S and cdr ~S~%" (car x) (cdr x))]
 	    [(procedure? x)
diff --git a/defaults.make b/defaults.make
index 703e2af1..1f7b92d9 100644
--- a/defaults.make
+++ b/defaults.make
@@ -292,7 +292,7 @@ CSI ?= csi$(EXE)
 
 # Scheme compiler flags
 
-CHICKEN_OPTIONS = -optimize-level 2 -include-path . -include-path $(SRCDIR) -inline
+CHICKEN_OPTIONS = -optimize-level 2 -include-path . -include-path $(SRCDIR) -inline -ignore-repository
 ifdef DEBUGBUILD
 CHICKEN_OPTIONS += -feature debugbuild -scrutinize -types $(SRCDIR)types.db
 else
diff --git a/support.scm b/support.scm
index f0e62bc2..ac6c8a05 100644
--- a/support.scm
+++ b/support.scm
@@ -1091,9 +1091,9 @@
 	  `(let ((,tmp ,body))
 	     (and ,tmp
 		  (not (##sys#null-pointer? ,tmp))
-		  (make ,(caddr type) 'this ,tmp) ) ) ) ]
+		  (make-instance ,(caddr type) 'this ,tmp) ) ) ) ]
        [(and (list? type) (= 3 (length type)) (eq? 'nonnull-instance (car type)))
-	`(make ,(caddr type) 'this ,body) ]
+	`(make-instance ,(caddr type) 'this ,body) ]
        [else body] ) ] ) )