From 60bbad167b0691995a659121acda55392e4021b6 Mon Sep 17 00:00:00 2001 From: Andrew Berkley Date: Sun, 4 Jul 2021 12:50:34 -0700 Subject: [PATCH] Fix for sbcl 2.1.6 --- compat.lisp | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/compat.lisp b/compat.lisp index 95a9869..ea6d1a1 100644 --- a/compat.lisp +++ b/compat.lisp @@ -1,12 +1,13 @@ (in-package #:png) -#+sbcl ; Present in SBCL 1.0.24. -(declaim (ftype (function (array) (values (simple-array * (*)) &optional)) - array-storage-vector)) - #+sbcl -(defun array-storage-vector (array) - "Returns the underlying storage vector of ARRAY, which must be a non-displaced array. +(macrolet ((make-array-storage-vector () + (let ((%array-data-vector (or (find-symbol "%ARRAY-DATA-VECTOR" :sb-kernel) + (find-symbol "%ARRAY-DATA" :sb-kernel)))) ;; renamed in sbcl 2.1.6 + `(progn + (declaim (ftype (function (array) (values (simple-array * (*)) &optional)) array-storage-vector)) + (defun array-storage-vector (array) + "Returns the underlying storage vector of ARRAY, which must be a non-displaced array. In SBCL, if ARRAY is a of type \(SIMPLE-ARRAY * \(*)), it is its own storage vector. Multidimensional arrays, arrays with fill pointers, and adjustable @@ -16,15 +17,14 @@ ARRAY, which this function returns. Important note: the underlying vector is an implementation detail. Even though this function exposes it, changes in the implementation may cause this function to be removed without further warning." - ;; KLUDGE: Without TRULY-THE the system is not smart enough to - ;; figure out that the return value is always of the known type. - (sb-ext:truly-the (simple-array * (*)) - (if (sb-kernel:array-header-p array) - (if (sb-kernel:%array-displaced-p array) - (error "~S cannot be used with displaced arrays. Use ~S instead." - 'array-storage-vector 'array-displacement) - (sb-kernel:%array-data-vector array)) - array))) + (sb-ext:truly-the (simple-array * (*)) + (if (sb-kernel:array-header-p array) + (if (sb-kernel:%array-displaced-p array) + (error "~S cannot be used with displaced arrays. Use ~S instead." + 'array-storage-vector 'array-displacement) + (,%array-data-vector array)) + array))))))) + (make-array-storage-vector)) #+allegro (defmacro with-pointer-to-array-data ((ptr-var array) &body body) -- 2.33.0 itch to "/current". * scripts/guix.in (augment-load-paths!): Remove use of ~/.config/guix/latest. * build-aux/compile-as-derivation.scm: Replace "/guix/latest/" with "/current/share/guile/site/X.Y" * guix/scripts.scm (warn-about-old-distro)[age]: Check "/current" instead of "/latest". * doc/guix.texi (Invoking guix pull): Document it. * doc/contributing.texi (Running Guix Before It Is Installed): Remove footnote about abusing ~/.config/guix/latest. Ludovic Courtès 2018-01-28guix: Let Emacs detect “scripts/guix.in” appropriate mode....Since commit 6f774d481839f87178c5895ac2d661e141f879b8 which introduces the use of Guile's meta switch in “scripts/guix.in”, Emacs was not using ‘scheme-mode’ for this file. * scripts/guix.in: Replace "-*- scheme -*-" with a local variable. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Mathieu Lirzin 2018-01-23guix: Refactor script....* scripts/guix.in: Remove empty surrounding ‘let’. Define 'main' as the procedure called when running the script. (maybe-augment-load-paths!): Rename to ... (augment-load-paths!): ... this. Use 'and=>' for 'file-exists?'. (run-guix-main): Rename to ... (main): ... this. Call 'augment-load-paths!'. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Mathieu Lirzin 2018-01-23build: Expand ‘scripts/guix’ at Make time....This moves the complexity of Autotools variable expansion outside of the application code. * scripts/guix.in (config-lookup): Delete. (maybe-augment-load-paths!, run-guix-main): Use fully expanded variables instead of calling ‘config-lookup’. * configure.ac: Don't use AC_CONFIG_FILES for ‘scripts/guix’. Use AC_PROG_SED. * Makefile.am (scripts/guix): New rule. (do_subst): New variable. (CLEANFILES, EXTRA_DIST): Adapt. Co-authored-by: Ludovic Courtès <ludo@gnu.org> Mathieu Lirzin