From 2074ff4dd17c68482986f2aa70a936f01853a1c8 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Mon, 13 Jun 2005 13:17:38 +0000
Subject: [PATCH] Bugs fixed:  - After (REQUIRE 'CMP) the module was not
 registered  - Provide MAKE-LOAD-FORM for some builtin objects (to be
 improved)  - FOREIGN-DATA was not recognized as a type by SUBTYPEP  -
 Documentation of functions not found by DOCUMENTATION

---
 src/CHANGELOG        | 10 +++++++---
 src/clos/builtin.lsp |  1 +
 src/clos/inspect.lsp |  3 +--
 src/clos/print.lsp   | 40 ++++++++++++++++++++++++++++++++++++++++
 src/cmp/cmpmain.lsp  |  1 +
 5 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index fd4742556..586fd0679 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -48,9 +48,13 @@ ECL 0.9g
  - The random number generator assumed 32-bit integers.
 
  - ext:run-program looks into *standard-input/output* and *error-output* for handle
-   duplication also under Win32.
- 
- - FEtype_error_index() had format arguments in wrong order (M. Goffioul).
+   duplicatio also under Win32.
+
+ - In the LOOP macro, variables are initialized with values of their type, no
+   longer producing code like (LET ((C NIL)) (DECLARE (CHARACTER C)) ...)
+
+ - The compiler now advertises itself with PROVIDE so that issuing (REQUIRE
+   'CMP) twice does not cause the compiler to be loaded twice.
 
 * ANSI compatibility:
 
diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp
index 4ec483b5c..bc893b623 100644
--- a/src/clos/builtin.lsp
+++ b/src/clos/builtin.lsp
@@ -83,6 +83,7 @@
 	    (hash-table)
 	    (random-state)
 	    (readtable)
+	    (si::foreign-data)
 	    #+threads (mp::process)
 	    #+threads (mp::lock)))
 
diff --git a/src/clos/inspect.lsp b/src/clos/inspect.lsp
index 64c6b91f7..f92ef8cc4 100644
--- a/src/clos/inspect.lsp
+++ b/src/clos/inspect.lsp
@@ -438,8 +438,7 @@ q (or Q):             quits the inspection.~%~
 	     (documentation c t)
 	     (si::get-documentation object doc-type))))
       (function
-       (if (fboundp object)
-	   (documentation (fdefinition object) doc-type)
+       (or (and (fboundp object) (documentation (fdefinition object) doc-type))
 	   (si::get-documentation object doc-type)))
       (otherwise
        (si::get-documentation object doc-type)))))
diff --git a/src/clos/print.lsp b/src/clos/print.lsp
index 56ac930f6..1ca973ed1 100644
--- a/src/clos/print.lsp
+++ b/src/clos/print.lsp
@@ -31,6 +31,46 @@
 		  `(slot-makunbound ,object ',slot-name))
 	      initialization)))))
 
+(defun need-to-make-load-form-p (object)
+  (typecase object
+    ((or character number symbol pathname string bit-vector)
+     nil)
+    ((array)
+     (unless (subtypep (array-element-type object) '(or character number))
+       (dotimes (i (array-total-size object) nil)
+	 (when (need-to-make-load-form-p (row-major-aref object i))
+	   (return-from need-to-make-load-form-p t)))))
+    ((cons)
+     (or (need-to-make-load-form-p (car object))
+	 (and (cdr object)
+	      (need-to-make-load-form-p (cdr object)))))
+    (t
+     t)))
+
+(defmethod make-load-form ((object t) &optional environment)
+  (unless (need-to-make-load-form-p object)
+    (return-from make-load-form (if (consp object) `',object object)))
+  (typecase object
+    ((array)
+     `(make-array ,(array-dimensions object)
+		  :element-type ,(array-element-type object)
+		  :adjustable ,(array-adjustable-p object)
+		  :initial-data
+		  ,(loop for i from 0 by (array-total-size object)
+			 collect (make-load-form (row-major-aref object i)))))
+    ((cons)
+     (do* ((x object)
+	   (out '()))
+	 ((atom x)
+	  (progn
+	    (setf out (mapcar #'make-load-form (nreverse out)))
+	    (if x
+		`(list* ,out ,(make-load-form x))
+	      `(list ,out))))
+       (push x out)))
+    (t
+     (error "Cannot externalize object ~a" object))))
+
 (defmethod make-load-form ((object standard-object) &optional environment)
   (make-load-form-saving-slots object))
 
diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
index aac21bb20..2741c5a40 100644
--- a/src/cmp/cmpmain.lsp
+++ b/src/cmp/cmpmain.lsp
@@ -746,3 +746,4 @@ Cannot compile ~a."
 #-ecl-min
 (load "sys:sysfun")
 
+(provide 'cmp)