Dear Anton,
can you (1) run cl-test-grid on all implementations with 3.1.0.94, our
release candidate?
can you run the cl-test-grid on at least SBCL with the latest ASDF and
the attached patch?
In writing my article "ASDF3, or Why Lisp is Now an Acceptable
Scripting Language", one of the limitations I list is the mess of
uncontrollable syntax.
This would fix it... but might break dirty files that side-effect the
current syntax
without first creating and using a new readtable. Breaking these files
is actually desired, but we need to check how large is the issue
before we do it (if we do).
I figure that, like any other potentially disruptive change, it is
best done just before a release that defines a new features, in this
case, #+asdf3.1
Of course, I won't commit any such thing to master without maintainer approval.
—♯ƒ • François-René ÐVB Rideau •Reflection&Cybernethics• http://fare.tunes.org
Ontogeny recapitulates phylogeny.
— Ernst Haeckel
From 846b7fba5e5be59b682b3bf46934edf95e280624 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tu...@google.com>
Date: Tue, 11 Mar 2014 21:37:01 -0400
Subject: [PATCH] Load and compile CL code using a predictable, standard
syntax. No more leakage from past files or to future files.
---
find-system.lisp | 2 +-
lisp-action.lisp | 13 ++++++++++---
uiop/stream.lisp | 5 +++++
3 files changed, 16 insertions(+), 4 deletions(-)
diff --git a/find-system.lisp b/find-system.lisp
index 564d135..a5f6880 100644
--- a/find-system.lisp
+++ b/find-system.lisp
@@ -277,7 +277,7 @@ Going forward, we recommend new users should be using the source-registry.
(defmacro with-system-definitions ((&optional) &body body)
`(call-with-system-definitions #'(lambda () ,@body)))
- (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*))
+ (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *standard-readtable*) (print-pprint-dispatch *standard-print-pprint-dispatch*))
;; Tries to load system definition with canonical NAME from PATHNAME.
(with-system-definitions ()
(with-standard-io-syntax
diff --git a/lisp-action.lisp b/lisp-action.lisp
index 0622c42..c2b9ffb 100644
--- a/lisp-action.lisp
+++ b/lisp-action.lisp
@@ -33,7 +33,14 @@
(defclass basic-load-op (operation) ())
(defclass basic-compile-op (operation)
((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil)
- (flags :initarg :flags :accessor compile-op-flags :initform nil))))
+ (flags :initarg :flags :accessor compile-op-flags :initform nil)))
+
+ (defclass cl-reading-op (operation) ())) ;; operations that read CL source
+ (defmethod perform :around ((o cl-reading-op) (c cl-source-file))
+ (with-standard-io-syntax
+ (let ((*package* (find-package :asdf-user))
+ (*print-readably* nil))
+ (call-next-method))))
;;; Our default operations: loading into the current lisp image
(with-upgradability ()
@@ -44,12 +51,12 @@
;; NB: even though compile-op depends on prepare-op it is not needed-in-image-p,
;; so we need to directly depend on prepare-op for its side-effects in the current image.
((selfward-operation :initform '(prepare-op compile-op) :allocation :class)))
- (defclass compile-op (basic-compile-op downward-operation selfward-operation)
+ (defclass compile-op (basic-compile-op cl-reading-op downward-operation selfward-operation)
((selfward-operation :initform 'prepare-op :allocation :class)))
(defclass prepare-source-op (upward-operation sideway-operation)
((sideway-operation :initform 'load-source-op :allocation :class)))
- (defclass load-source-op (basic-load-op downward-operation selfward-operation)
+ (defclass load-source-op (basic-load-op cl-reading-op downward-operation selfward-operation)
((selfward-operation :initform 'prepare-source-op :allocation :class)))
(defclass test-op (selfward-operation)
diff --git a/uiop/stream.lisp b/uiop/stream.lisp
index 464e933..bd620e1 100644
--- a/uiop/stream.lisp
+++ b/uiop/stream.lisp
@@ -11,6 +11,7 @@
#:detect-encoding #:*encoding-detection-hook* #:always-default-encoding
#:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format
#:*default-encoding* #:*utf-8-external-format*
+ #:*standard-readtable* #:*standard-print-pprint-dispatch*
#:with-safe-io-syntax #:call-with-safe-io-syntax #:safe-read-from-string
#:with-output #:output-string #:with-input
#:with-input-file #:call-with-input-file #:with-output-file #:call-with-output-file
@@ -146,6 +147,10 @@ going through all the proper hooks."
"The standard readtable, implementing the syntax specified by the CLHS.
It must never be modified, though only good implementations will even enforce that.")
+ (defvar *standard-print-pprint-dispatch* (with-standard-io-syntax *print-pprint-dispatch*)
+ "The standard pprint dispatch table, implementing the syntax specified by the CLHS.
+It must never be modified, though only good implementations will even enforce that.")
+
(defmacro with-safe-io-syntax ((&key (package :cl)) &body body)
"Establish safe CL reader options around the evaluation of BODY"
`(call-with-safe-io-syntax #'(lambda () (let ((*package* (find-package ,package))) ,@body))))
--
1.9.0.279.gdc9e3eb
