Changeset 13275 for trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

Timestamp:

05/07/11 23:31:35 (13 years ago)

Author:

ehuelsmann

Message:

Fix the remainder of ticket #147: make sure we write proper-case
symbol and package names to allow case sensitive reading of symbols
as required by (e.g.) Qi.

File:

• trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -593 +593 @@
             (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
             (%stream-terpri out)
-            (let ((*package* (find-package '#:cl)))
+            (let ((*package* (find-package '#:cl))
+                  (*print-fasl* t)
+                  (*print-array* t)
+                  (*print-base* 10)
+                  (*print-case* :upcase)
+                  (*print-circle* nil)
+                  (*print-escape* t)
+                  (*print-gensym* t)
+                  (*print-length* nil)
+                  (*print-level* nil)
+                  (*print-lines* nil)
+                  (*print-pretty* nil)
+                  (*print-radix* nil)
+                  (*print-readably* t)
+                  (*print-right-margin* nil)
+                  (*print-structure* t)
+
+                  ;; make sure to write all floats with their exponent marker:
+                  ;; the dump-time default may not be the same at load-time
+
+                  (*read-default-float-format* nil))
+
+              ;; these values are also bound by WITH-STANDARD-IO-SYNTAX,
+              ;; but not used by our reader/printer, so don't bind them,
+              ;; for efficiency reasons.
+              ;;        (*read-eval* t)
+              ;;        (*read-suppress* nil)
+              ;;        (*print-miser-width* nil)
+              ;;        (*print-pprint-dispatch* (copy-pprint-dispatch nil))
+              ;;        (*read-base* 10)
+              ;;        (*read-default-float-format* 'single-float)
+              ;;        (*readtable* (copy-readtable nil))
+
               (write (list 'init-fasl :version *fasl-version*)
                      :stream out)