From: stassats <sta...@us...> - 2013-07-04 09:59:08
|
The branch "master" has been updated in SBCL: via b4fa259c1a797ff591c45a9bca7808dd22acf582 (commit) from a20451dd6fb41033ab135334c27b15184425550a (commit) - Log ----------------------------------------------------------------- commit b4fa259c1a797ff591c45a9bca7808dd22acf582 Author: Stas Boukarev <sta...@gm...> Date: Thu Jul 4 13:58:54 2013 +0400 Update ASDF to 3.0.2. --- NEWS | 3 + contrib/asdf/Makefile | 3 +- contrib/asdf/README | 17 +- contrib/asdf/asdf.lisp |13760 +++++++++++++++++++++++++++++++-------------- contrib/asdf/asdf.texinfo | 964 +++- 5 files changed, 10206 insertions(+), 4541 deletions(-) diff --git a/NEWS b/NEWS index 5b304c7..25ec549 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,7 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- +changes relative to sbcl-1.1.9: + * enhancement: ASDF has been updated to 3.0.2. + changes in sbcl-1.1.9 relative to sbcl-1.1.8: * new feature: the contrib SB-GMP links with libgmp at runtime to speed up arithmetic on bignums and ratios. (contributed by Stephan Frank) diff --git a/contrib/asdf/Makefile b/contrib/asdf/Makefile index fc4dbc8..4855a3b 100644 --- a/contrib/asdf/Makefile +++ b/contrib/asdf/Makefile @@ -7,6 +7,7 @@ test:: up: sh pull-asdf.sh - cp asdf-upstream/asdf.lisp asdf.lisp + (cd asdf-upstream; make build/asdf.lisp) + cp asdf-upstream/build/asdf.lisp asdf.lisp cp asdf-upstream/doc/asdf.texinfo asdf.texinfo cp asdf-upstream/README README diff --git a/contrib/asdf/README b/contrib/asdf/README index eb604a4..ccab965 100644 --- a/contrib/asdf/README +++ b/contrib/asdf/README @@ -1,20 +1,25 @@ ASDF: another system definition facility ======================================== -If you want to use ASDF, read our manual: +If you cloned our git repository, bootstrap a copy of build/asdf.lisp with: + make + +To use ASDF, read our manual: http://common-lisp.net/project/asdf/asdf.html - The first few sections, Loading ASDF, Configuring ASDF and Using ASDF, will get you started as a simple user. - If you want to define your own systems, further read the section Defining systems with defsystem. -More information and additional links can be found on ASDF's -home page at: +ASDF 3 now includes an extensive runtime support library: +UIOP, the Utilities for Implementation- and OS- Portability. +Its documentation unhappily lies mainly in the source code and docstrings. + + +More information and additional links can be found on ASDF's home page at: http://common-lisp.net/project/asdf/ -last updated Wednesday; May 5, 2010 +Last updated Thursday, April 10th, 2013. diff --git a/contrib/asdf/asdf.lisp b/contrib/asdf/asdf.lisp index ce7a1db..e90fae7 100644 --- a/contrib/asdf/asdf.lisp +++ b/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ -;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26: Another System Definition Facility. +;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- +;;; This is ASDF 3.0.2: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asd...@co...>. @@ -47,436 +47,896 @@ #+xcvb (module ()) -(cl:in-package :common-lisp-user) -#+genera (in-package :future-common-lisp-user) +(in-package :cl-user) -#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) -(error "ASDF is not supported on your implementation. Please help us port it.") +#+cmu +(eval-when (:load-toplevel :compile-toplevel :execute) + (declaim (optimize (speed 1) (safety 3) (debug 3))) + (setf ext:*gc-verbose* nil)) + +#+(or abcl clisp clozure cmu ecl xcl) +(eval-when (:load-toplevel :compile-toplevel :execute) + (unless (member :asdf3 *features*) + (let* ((existing-version + (when (find-package :asdf) + (or (symbol-value (find-symbol (string :*asdf-version*) :asdf)) + (let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf)))) + (etypecase ver + (string ver) + (cons (format nil "~{~D~^.~}" ver)) + (null "1.0")))))) + (first-dot (when existing-version (position #\. existing-version))) + (second-dot (when first-dot (position #\. existing-version :start (1+ first-dot)))) + (existing-major-minor (subseq existing-version 0 second-dot)) + (existing-version-number (and existing-version (read-from-string existing-major-minor))) + (away (format nil "~A-~A" :asdf existing-version))) + (when (and existing-version + (< existing-version-number #+abcl 2.25 #+cmu 2.018 #-(or abcl cmu) 2.27)) + (rename-package :asdf away) + (when *load-verbose* + (format t "~&; Renamed old ~A package away to ~A~%" :asdf away)))))) + +;;;; --------------------------------------------------------------------------- +;;;; Handle ASDF package upgrade, including implementation-dependent magic. +;; +;; See https://bugs.launchpad.net/asdf/+bug/485687 +;; + +(defpackage :uiop/package + ;; CAUTION: we must handle the first few packages specially for hot-upgrade. + ;; This package definition MUST NOT change unless its name too changes; + ;; if/when it changes, don't forget to add new functions missing from below. + ;; Until then, asdf/package is frozen to forever + ;; import and export the same exact symbols as for ASDF 2.27. + ;; Any other symbol must be import-from'ed and re-export'ed in a different package. + (:use :common-lisp) + (:export + #:find-package* #:find-symbol* #:symbol-call + #:intern* #:export* #:import* #:shadowing-import* #:shadow* #:make-symbol* #:unintern* + #:symbol-shadowing-p #:home-package-p + #:symbol-package-name #:standard-common-lisp-symbol-p + #:reify-package #:unreify-package #:reify-symbol #:unreify-symbol + #:nuke-symbol-in-package #:nuke-symbol #:rehome-symbol + #:ensure-package-unused #:delete-package* + #:package-names #:packages-from-names #:fresh-package-name #:rename-package-away + #:package-definition-form #:parse-define-package-form + #:ensure-package #:define-package)) + +(in-package :uiop/package) + +;;;; General purpose package utilities + +(eval-when (:load-toplevel :compile-toplevel :execute) + (defun find-package* (package-designator &optional (error t)) + (let ((package (find-package package-designator))) + (cond + (package package) + (error (error "No package named ~S" (string package-designator))) + (t nil)))) + (defun find-symbol* (name package-designator &optional (error t)) + "Find a symbol in a package of given string'ified NAME; +unless CL:FIND-SYMBOL, work well with 'modern' case sensitive syntax +by letting you supply a symbol or keyword for the name; +also works well when the package is not present. +If optional ERROR argument is NIL, return NIL instead of an error +when the symbol is not found." + (block nil + (let ((package (find-package* package-designator error))) + (when package ;; package error handled by find-package* already + (multiple-value-bind (symbol status) (find-symbol (string name) package) + (cond + (status (return (values symbol status))) + (error (error "There is no symbol ~S in package ~S" name (package-name package)))))) + (values nil nil)))) + (defun symbol-call (package name &rest args) + "Call a function associated with symbol of given name in given package, +with given ARGS. Useful when the call is read before the package is loaded, +or when loading the package is optional." + (apply (find-symbol* name package) args)) + (defun intern* (name package-designator &optional (error t)) + (intern (string name) (find-package* package-designator error))) + (defun export* (name package-designator) + (let* ((package (find-package* package-designator)) + (symbol (intern* name package))) + (export (or symbol (list symbol)) package))) + (defun import* (symbol package-designator) + (import (or symbol (list symbol)) (find-package* package-designator))) + (defun shadowing-import* (symbol package-designator) + (shadowing-import (or symbol (list symbol)) (find-package* package-designator))) + (defun shadow* (name package-designator) + (shadow (string name) (find-package* package-designator))) + (defun make-symbol* (name) + (etypecase name + (string (make-symbol name)) + (symbol (copy-symbol name)))) + (defun unintern* (name package-designator &optional (error t)) + (block nil + (let ((package (find-package* package-designator error))) + (when package + (multiple-value-bind (symbol status) (find-symbol* name package error) + (cond + (status (unintern symbol package) + (return (values symbol status))) + (error (error "symbol ~A not present in package ~A" + (string symbol) (package-name package)))))) + (values nil nil)))) + (defun symbol-shadowing-p (symbol package) + (and (member symbol (package-shadowing-symbols package)) t)) + (defun home-package-p (symbol package) + (and package (let ((sp (symbol-package symbol))) + (and sp (let ((pp (find-package* package))) + (and pp (eq sp pp)))))))) + + +(eval-when (:load-toplevel :compile-toplevel :execute) + (defun symbol-package-name (symbol) + (let ((package (symbol-package symbol))) + (and package (package-name package)))) + (defun standard-common-lisp-symbol-p (symbol) + (multiple-value-bind (sym status) (find-symbol* symbol :common-lisp nil) + (and (eq sym symbol) (eq status :external)))) + (defun reify-package (package &optional package-context) + (if (eq package package-context) t + (etypecase package + (null nil) + ((eql (find-package :cl)) :cl) + (package (package-name package))))) + (defun unreify-package (package &optional package-context) + (etypecase package + (null nil) + ((eql t) package-context) + ((or symbol string) (find-package package)))) + (defun reify-symbol (symbol &optional package-context) + (etypecase symbol + ((or keyword (satisfies standard-common-lisp-symbol-p)) symbol) + (symbol (vector (symbol-name symbol) + (reify-package (symbol-package symbol) package-context))))) + (defun unreify-symbol (symbol &optional package-context) + (etypecase symbol + (symbol symbol) + ((simple-vector 2) + (let* ((symbol-name (svref symbol 0)) + (package-foo (svref symbol 1)) + (package (unreify-package package-foo package-context))) + (if package (intern* symbol-name package) + (make-symbol* symbol-name))))))) -;;;; Create and setup packages in a way that is compatible with hot-upgrade. -;;;; See https://bugs.launchpad.net/asdf/+bug/485687 -;;;; See these two eval-when forms, and more near the end of the file. +(eval-when (:load-toplevel :compile-toplevel :execute) + (defvar *all-package-happiness* '()) + (defvar *all-package-fishiness* (list t)) + (defun record-fishy (info) + ;;(format t "~&FISHY: ~S~%" info) + (push info *all-package-fishiness*)) + (defmacro when-package-fishiness (&body body) + `(when *all-package-fishiness* ,@body)) + (defmacro note-package-fishiness (&rest info) + `(when-package-fishiness (record-fishy (list ,@info))))) + +(eval-when (:load-toplevel :compile-toplevel :execute) + #+(or clisp clozure) + (defun get-setf-function-symbol (symbol) + #+clisp (let ((sym (get symbol 'system::setf-function))) + (if sym (values sym :setf-function) + (let ((sym (get symbol 'system::setf-expander))) + (if sym (values sym :setf-expander) + (values nil nil))))) + #+clozure (gethash symbol ccl::%setf-function-names%)) + #+(or clisp clozure) + (defun set-setf-function-symbol (new-setf-symbol symbol &optional kind) + #+clisp (assert (member kind '(:setf-function :setf-expander))) + #+clozure (assert (eq kind t)) + #+clisp + (cond + ((null new-setf-symbol) + (remprop symbol 'system::setf-function) + (remprop symbol 'system::setf-expander)) + ((eq kind :setf-function) + (setf (get symbol 'system::setf-function) new-setf-symbol)) + ((eq kind :setf-expander) + (setf (get symbol 'system::setf-expander) new-setf-symbol)) + (t (error "invalid kind of setf-function ~S for ~S to be set to ~S" + kind symbol new-setf-symbol))) + #+clozure + (progn + (gethash symbol ccl::%setf-function-names%) new-setf-symbol + (gethash new-setf-symbol ccl::%setf-function-name-inverses%) symbol)) + #+(or clisp clozure) + (defun create-setf-function-symbol (symbol) + #+clisp (system::setf-symbol symbol) + #+clozure (ccl::construct-setf-function-name symbol)) + (defun set-dummy-symbol (symbol reason other-symbol) + (setf (get symbol 'dummy-symbol) (cons reason other-symbol))) + (defun make-dummy-symbol (symbol) + (let ((dummy (copy-symbol symbol))) + (set-dummy-symbol dummy 'replacing symbol) + (set-dummy-symbol symbol 'replaced-by dummy) + dummy)) + (defun dummy-symbol (symbol) + (get symbol 'dummy-symbol)) + (defun get-dummy-symbol (symbol) + (let ((existing (dummy-symbol symbol))) + (if existing (values (cdr existing) (car existing)) + (make-dummy-symbol symbol)))) + (defun nuke-symbol-in-package (symbol package-designator) + (let ((package (find-package* package-designator)) + (name (symbol-name symbol))) + (multiple-value-bind (sym stat) (find-symbol name package) + (when (and (member stat '(:internal :external)) (eq symbol sym)) + (if (symbol-shadowing-p symbol package) + (shadowing-import* (get-dummy-symbol symbol) package) + (unintern* symbol package)))))) + (defun nuke-symbol (symbol &optional (packages (list-all-packages))) + #+(or clisp clozure) + (multiple-value-bind (setf-symbol kind) + (get-setf-function-symbol symbol) + (when kind (nuke-symbol setf-symbol))) + (loop :for p :in packages :do (nuke-symbol-in-package symbol p))) + (defun rehome-symbol (symbol package-designator) + "Changes the home package of a symbol, also leaving it present in its old home if any" + (let* ((name (symbol-name symbol)) + (package (find-package* package-designator)) + (old-package (symbol-package symbol)) + (old-status (and old-package (nth-value 1 (find-symbol name old-package)))) + (shadowing (and old-package (symbol-shadowing-p symbol old-package) (make-symbol name)))) + (multiple-value-bind (overwritten-symbol overwritten-symbol-status) (find-symbol name package) + (unless (eq package old-package) + (let ((overwritten-symbol-shadowing-p + (and overwritten-symbol-status + (symbol-shadowing-p overwritten-symbol package)))) + (note-package-fishiness + :rehome-symbol name + (when old-package (package-name old-package)) old-status (and shadowing t) + (package-name package) overwritten-symbol-status overwritten-symbol-shadowing-p) + (when old-package + (if shadowing + (shadowing-import* shadowing old-package)) + (unintern* symbol old-package)) + (cond + (overwritten-symbol-shadowing-p + (shadowing-import* symbol package)) + (t + (when overwritten-symbol-status + (unintern* overwritten-symbol package)) + (import* symbol package))) + (if shadowing + (shadowing-import* symbol old-package) + (import* symbol old-package)) + #+(or clisp clozure) + (multiple-value-bind (setf-symbol kind) + (get-setf-function-symbol symbol) + (when kind + (let* ((setf-function (fdefinition setf-symbol)) + (new-setf-symbol (create-setf-function-symbol symbol))) + (note-package-fishiness + :setf-function + name (package-name package) + (symbol-name setf-symbol) (symbol-package-name setf-symbol) + (symbol-name new-setf-symbol) (symbol-package-name new-setf-symbol)) + (when (symbol-package setf-symbol) + (unintern* setf-symbol (symbol-package setf-symbol))) + (setf (fdefinition new-setf-symbol) setf-function) + (set-setf-function-symbol new-setf-symbol symbol kind)))) + #+(or clisp clozure) + (multiple-value-bind (overwritten-setf foundp) + (get-setf-function-symbol overwritten-symbol) + (when foundp + (unintern overwritten-setf))) + (when (eq old-status :external) + (export* symbol old-package)) + (when (eq overwritten-symbol-status :external) + (export* symbol package)))) + (values overwritten-symbol overwritten-symbol-status)))) + (defun ensure-package-unused (package) + (loop :for p :in (package-used-by-list package) :do + (unuse-package package p))) + (defun delete-package* (package &key nuke) + (let ((p (find-package package))) + (when p + (when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))) + (ensure-package-unused p) + (delete-package package)))) + (defun package-names (package) + (cons (package-name package) (package-nicknames package))) + (defun packages-from-names (names) + (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t)) + (defun fresh-package-name (&key (prefix :%TO-BE-DELETED) + separator + (index (random most-positive-fixnum))) + (loop :for i :from index + :for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i) + :thereis (and (not (find-package n)) n))) + (defun rename-package-away (p &rest keys &key prefix &allow-other-keys) + (let ((new-name + (apply 'fresh-package-name + :prefix (or prefix (format nil "__~A__" (package-name p))) keys))) + (record-fishy (list :rename-away (package-names p) new-name)) + (rename-package p new-name)))) + + +;;; Communicable representation of symbol and package information + +(eval-when (:load-toplevel :compile-toplevel :execute) + (defun package-definition-form (package-designator + &key (nicknamesp t) (usep t) + (shadowp t) (shadowing-import-p t) + (exportp t) (importp t) internp (error t)) + (let* ((package (or (find-package* package-designator error) + (return-from package-definition-form nil))) + (name (package-name package)) + (nicknames (package-nicknames package)) + (use (mapcar #'package-name (package-use-list package))) + (shadow ()) + (shadowing-import (make-hash-table :test 'equal)) + (import (make-hash-table :test 'equal)) + (export ()) + (intern ())) + (when package + (loop :for sym :being :the :symbols :in package + :for status = (nth-value 1 (find-symbol* sym package)) :do + (ecase status + ((nil :inherited)) + ((:internal :external) + (let* ((name (symbol-name sym)) + (external (eq status :external)) + (home (symbol-package sym)) + (home-name (package-name home)) + (imported (not (eq home package))) + (shadowing (symbol-shadowing-p sym package))) + (cond + ((and shadowing imported) + (push name (gethash home-name shadowing-import))) + (shadowing + (push name shadow)) + (imported + (push name (gethash home-name import)))) + (cond + (external + (push name export)) + (imported) + (t (push name intern))))))) + (labels ((sort-names (names) + (sort names #'string<)) + (table-keys (table) + (loop :for k :being :the :hash-keys :of table :collect k)) + (when-relevant (key value) + (when value (list (cons key value)))) + (import-options (key table) + (loop :for i :in (sort-names (table-keys table)) + :collect `(,key ,i ,@(sort-names (gethash i table)))))) + `(defpackage ,name + ,@(when-relevant :nicknames (and nicknamesp (sort-names nicknames))) + (:use ,@(and usep (sort-names use))) + ,@(when-relevant :shadow (and shadowp (sort-names shadow))) + ,@(import-options :shadowing-import-from (and shadowing-import-p shadowing-import)) + ,@(import-options :import-from (and importp import)) + ,@(when-relevant :export (and exportp (sort-names export))) + ,@(when-relevant :intern (and internp (sort-names intern))))))))) + + +;;; ensure-package, define-package +(eval-when (:load-toplevel :compile-toplevel :execute) + (defun ensure-shadowing-import (name to-package from-package shadowed imported) + (check-type name string) + (check-type to-package package) + (check-type from-package package) + (check-type shadowed hash-table) + (check-type imported hash-table) + (let ((import-me (find-symbol* name from-package))) + (multiple-value-bind (existing status) (find-symbol name to-package) + (cond + ((gethash name shadowed) + (unless (eq import-me existing) + (error "Conflicting shadowings for ~A" name))) + (t + (setf (gethash name shadowed) t) + (setf (gethash name imported) t) + (unless (or (null status) + (and (member status '(:internal :external)) + (eq existing import-me) + (symbol-shadowing-p existing to-package))) + (note-package-fishiness + :shadowing-import name + (package-name from-package) + (or (home-package-p import-me from-package) (symbol-package-name import-me)) + (package-name to-package) status + (and status (or (home-package-p existing to-package) (symbol-package-name existing))))) + (shadowing-import* import-me to-package)))))) + (defun ensure-imported (import-me into-package &optional from-package) + (check-type import-me symbol) + (check-type into-package package) + (check-type from-package (or null package)) + (let ((name (symbol-name import-me))) + (multiple-value-bind (existing status) (find-symbol name into-package) + (cond + ((not status) + (import* import-me into-package)) + ((eq import-me existing)) + (t + (let ((shadowing-p (symbol-shadowing-p existing into-package))) + (note-package-fishiness + :ensure-imported name + (and from-package (package-name from-package)) + (or (home-package-p import-me from-package) (symbol-package-name import-me)) + (package-name into-package) + status + (and status (or (home-package-p existing into-package) (symbol-package-name existing))) + shadowing-p) + (cond + ((or shadowing-p (eq status :inherited)) + (shadowing-import* import-me into-package)) + (t + (unintern* existing into-package) + (import* import-me into-package)))))))) + (values)) + (defun ensure-import (name to-package from-package shadowed imported) + (check-type name string) + (check-type to-package package) + (check-type from-package package) + (check-type shadowed hash-table) + (check-type imported hash-table) + (multiple-value-bind (import-me import-status) (find-symbol name from-package) + (when (null import-status) + (note-package-fishiness + :import-uninterned name (package-name from-package) (package-name to-package)) + (setf import-me (intern* name from-package))) + (multiple-value-bind (existing status) (find-symbol name to-package) + (cond + ((and imported (gethash name imported)) + (unless (and status (eq import-me existing)) + (error "Can't import ~S from both ~S and ~S" + name (package-name (symbol-package existing)) (package-name from-package)))) + ((gethash name shadowed) + (error "Can't both shadow ~S and import it from ~S" name (package-name from-package))) + (t + (setf (gethash name imported) t)))) + (ensure-imported import-me to-package from-package))) + (defun ensure-inherited (name symbol to-package from-package mixp shadowed imported inherited) + (check-type name string) + (check-type symbol symbol) + (check-type to-package package) + (check-type from-package package) + (check-type mixp (member nil t)) ; no cl:boolean on Genera + (check-type shadowed hash-table) + (check-type imported hash-table) + (check-type inherited hash-table) + (multiple-value-bind (existing status) (find-symbol name to-package) + (let* ((sp (symbol-package symbol)) + (in (gethash name inherited)) + (xp (and status (symbol-package existing)))) + (when (null sp) + (note-package-fishiness + :import-uninterned name + (package-name from-package) (package-name to-package) mixp) + (import* symbol from-package) + (setf sp (package-name from-package))) + (cond + ((gethash name shadowed)) + (in + (unless (equal sp (first in)) + (if mixp + (ensure-shadowing-import name to-package (second in) shadowed imported) + (error "Can't inherit ~S from ~S, it is inherited from ~S" + name (package-name sp) (package-name (first in)))))) + ((gethash name imported) + (unless (eq symbol existing) + (error "Can't inherit ~S from ~S, it is imported from ~S" + name (package-name sp) (package-name xp)))) + (t + (setf (gethash name inherited) (list sp from-package)) + (when (and status (not (eq sp xp))) + (let ((shadowing (symbol-shadowing-p existing to-package))) + (note-package-fishiness + :inherited name + (package-name from-package) + (or (home-package-p symbol from-package) (symbol-package-name symbol)) + (package-name to-package) + (or (home-package-p existing to-package) (symbol-package-name existing))) + (if shadowing (ensure-shadowing-import name to-package from-package shadowed imported) + (unintern* existing to-package))))))))) + (defun ensure-mix (name symbol to-package from-package shadowed imported inherited) + (check-type name string) + (check-type symbol symbol) + (check-type to-package package) + (check-type from-package package) + (check-type shadowed hash-table) + (check-type imported hash-table) + (check-type inherited hash-table) + (unless (gethash name shadowed) + (multiple-value-bind (existing status) (find-symbol name to-package) + (let* ((sp (symbol-package symbol)) + (im (gethash name imported)) + (in (gethash name inherited))) + (cond + ((or (null status) + (and status (eq symbol existing)) + (and in (eq sp (first in)))) + (ensure-inherited name symbol to-package from-package t shadowed imported inherited)) + (in + (remhash name inherited) + (ensure-shadowing-import name to-package (second in) shadowed imported)) + (im + (error "Symbol ~S import from ~S~:[~; actually ~:[uninterned~;~:*from ~S~]~] conflicts with existing symbol in ~S~:[~; actually ~:[uninterned~;from ~:*~S~]~]" + name (package-name from-package) + (home-package-p symbol from-package) (symbol-package-name symbol) + (package-name to-package) + (home-package-p existing to-package) (symbol-package-name existing))) + (t + (ensure-inherited name symbol to-package from-package t shadowed imported inherited))))))) + (defun recycle-symbol (name recycle exported) + (check-type name string) + (check-type recycle list) + (check-type exported hash-table) + (when (gethash name exported) ;; don't bother recycling private symbols + (let (recycled foundp) + (dolist (r recycle (values recycled foundp)) + (multiple-value-bind (symbol status) (find-symbol name r) + (when (and status (home-package-p symbol r)) + (cond + (foundp + ;; (nuke-symbol symbol)) -- even simple variable names like O or C will do that. + (note-package-fishiness :recycled-duplicate name (package-name foundp) (package-name r))) + (t + (setf recycled symbol foundp r))))))))) + (defun symbol-recycled-p (sym recycle) + (check-type sym symbol) + (check-type recycle list) + (and (member (symbol-package sym) recycle) t)) + (defun ensure-symbol (name package intern recycle shadowed imported inherited exported) + (check-type name string) + (check-type package package) + (check-type intern (member nil t)) ; no cl:boolean on Genera + (check-type shadowed hash-table) + (check-type imported hash-table) + (check-type inherited hash-table) + (unless (or (gethash name shadowed) + (gethash name imported) + (gethash name inherited)) + (multiple-value-bind (existing status) + (find-symbol name package) + (multiple-value-bind (recycled previous) (recycle-symbol name recycle exported) + (cond + ((and status (eq existing recycled) (eq previous package))) + (previous + (rehome-symbol recycled package)) + ((and status (eq package (symbol-package existing)))) + (t + (when status + (note-package-fishiness + :ensure-symbol name + (reify-package (symbol-package existing) package) + status intern) + (unintern existing)) + (when intern + (intern* name package)))))))) + (declaim (ftype function ensure-exported)) + (defun ensure-exported-to-user (name symbol to-package &optional recycle) + (check-type name string) + (check-type symbol symbol) + (check-type to-package package) + (check-type recycle list) + (assert (equal name (symbol-name symbol))) + (multiple-value-bind (existing status) (find-symbol name to-package) + (unless (and status (eq symbol existing)) + (let ((accessible + (or (null status) + (let ((shadowing (symbol-shadowing-p existing to-package)) + (recycled (symbol-recycled-p existing recycle))) + (unless (and shadowing (not recycled)) + (note-package-fishiness + :ensure-export name (symbol-package-name symbol) + (package-name to-package) + (or (home-package-p existing to-package) (symbol-package-name existing)) + status shadowing) + (if (or (eq status :inherited) shadowing) + (shadowing-import* symbol to-package) + (unintern existing to-package)) + t))))) + (when (and accessible (eq status :external)) + (ensure-exported name symbol to-package recycle)))))) + (defun ensure-exported (name symbol from-package &optional recycle) + (dolist (to-package (package-used-by-list from-package)) + (ensure-exported-to-user name symbol to-package recycle)) + (unless (eq from-package (symbol-package symbol)) + (ensure-imported symbol from-package)) + (export* name from-package)) + (defun ensure-export (name from-package &optional recycle) + (multiple-value-bind (symbol status) (find-symbol* name from-package) + (unless (eq status :external) + (ensure-exported name symbol from-package recycle)))) + (defun ensure-package (name &key + nicknames documentation use + shadow shadowing-import-from + import-from export intern + recycle mix reexport + unintern) + #+(or gcl2.6 genera) (declare (ignore documentation)) + (let* ((package-name (string name)) + (nicknames (mapcar #'string nicknames)) + (names (cons package-name nicknames)) + (previous (packages-from-names names)) + (discarded (cdr previous)) + (to-delete ()) + (package (or (first previous) (make-package package-name :nicknames nicknames))) + (recycle (packages-from-names recycle)) + (use (mapcar 'find-package* use)) + (mix (mapcar 'find-package* mix)) + (reexport (mapcar 'find-package* reexport)) + (shadow (mapcar 'string shadow)) + (export (mapcar 'string export)) + (intern (mapcar 'string intern)) + (unintern (mapcar 'string unintern)) + (shadowed (make-hash-table :test 'equal)) ; string to bool + (imported (make-hash-table :test 'equal)) ; string to bool + (exported (make-hash-table :test 'equal)) ; string to bool + ;; string to list home package and use package: + (inherited (make-hash-table :test 'equal))) + (when-package-fishiness (record-fishy package-name)) + #-(or gcl2.6 genera) + (when documentation (setf (documentation package t) documentation)) + (loop :for p :in (set-difference (package-use-list package) (append mix use)) + :do (note-package-fishiness :over-use name (package-names p)) + (unuse-package p package)) + (loop :for p :in discarded + :for n = (remove-if #'(lambda (x) (member x names :test 'equal)) + (package-names p)) + :do (note-package-fishiness :nickname name (package-names p)) + (cond (n (rename-package p (first n) (rest n))) + (t (rename-package-away p) + (push p to-delete)))) + (rename-package package package-name nicknames) + (dolist (name unintern) + (multiple-value-bind (existing status) (find-symbol name package) + (when status + (unless (eq status :inherited) + (note-package-fishiness + :unintern (package-name package) name (symbol-package-name existing) status) + (unintern* name package nil))))) + (dolist (name export) + (setf (gethash name exported) t)) + (dolist (p reexport) + (do-external-symbols (sym p) + (setf (gethash (string sym) exported) t))) + (do-external-symbols (sym package) + (let ((name (symbol-name sym))) + (unless (gethash name exported) + (note-package-fishiness + :over-export (package-name package) name + (or (home-package-p sym package) (symbol-package-name sym))) + (unexport sym package)))) + (dolist (name shadow) + (setf (gethash name shadowed) t) + (multiple-value-bind (existing status) (find-symbol name package) + (multiple-value-bind (recycled previous) (recycle-symbol name recycle exported) + (let ((shadowing (and status (symbol-shadowing-p existing package)))) + (cond + ((eq previous package)) + (previous + (rehome-symbol recycled package)) + ((or (member status '(nil :inherited)) + (home-package-p existing package))) + (t + (let ((dummy (make-symbol name))) + (note-package-fishiness + :shadow-imported (package-name package) name + (symbol-package-name existing) status shadowing) + (shadowing-import* dummy package) + (import* dummy package))))))) + (shadow* name package)) + (loop :for (p . syms) :in shadowing-import-from + :for pp = (find-package* p) :do + (dolist (sym syms) (ensure-shadowing-import (string sym) package pp shadowed imported))) + (loop :for p :in mix + :for pp = (find-package* p) :do + (do-external-symbols (sym pp) (ensure-mix (symbol-name sym) sym package pp shadowed imported inherited))) + (loop :for (p . syms) :in import-from + :for pp = (find-package p) :do + (dolist (sym syms) (ensure-import (symbol-name sym) package pp shadowed imported))) + (dolist (p (append use mix)) + (do-external-symbols (sym p) (ensure-inherited (string sym) sym package p nil shadowed imported inherited)) + (use-package p package)) + (loop :for name :being :the :hash-keys :of exported :do + (ensure-symbol name package t recycle shadowed imported inherited exported) + (ensure-export name package recycle)) + (dolist (name intern) + (ensure-symbol name package t recycle shadowed imported inherited exported)) + (do-symbols (sym package) + (ensure-symbol (symbol-name sym) package nil recycle shadowed imported inherited exported)) + (map () 'delete-package* to-delete) + package))) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (defun parse-define-package-form (package clauses) + (loop + :with use-p = nil :with recycle-p = nil + :with documentation = nil + :for (kw . args) :in clauses + :when (eq kw :nicknames) :append args :into nicknames :else + :when (eq kw :documentation) + :do (cond + (documentation (error "define-package: can't define documentation twice")) + ((or (atom args) (cdr args)) (error "define-package: bad documentation")) + (t (setf documentation (car args)))) :else + :when (eq kw :use) :append args :into use :and :do (setf use-p t) :else + :when (eq kw :shadow) :append args :into shadow :else + :when (eq kw :shadowing-import-from) :collect args :into shadowing-import-from :else + :when (eq kw :import-from) :collect args :into import-from :else + :when (eq kw :export) :append args :into export :else + :when (eq kw :intern) :append args :into intern :else + :when (eq kw :recycle) :append args :into recycle :and :do (setf recycle-p t) :else + :when (eq kw :mix) :append args :into mix :else + :when (eq kw :reexport) :append args :into reexport :else + :when (eq kw :unintern) :append args :into unintern :else + :do (error "unrecognized define-package keyword ~S" kw) + :finally (return `(,package + :nicknames ,nicknames :documentation ,documentation + :use ,(if use-p use '(:common-lisp)) + :shadow ,shadow :shadowing-import-from ,shadowing-import-from + :import-from ,import-from :export ,export :intern ,intern + :recycle ,(if recycle-p recycle (cons package nicknames)) + :mix ,mix :reexport ,reexport :unintern ,unintern))))) -#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this +(defmacro define-package (package &rest clauses) + (let ((ensure-form + `(apply 'ensure-package ',(parse-define-package-form package clauses)))) + `(progn + #+clisp + (eval-when (:compile-toplevel :load-toplevel :execute) + ,ensure-form) + #+(or clisp ecl gcl) (defpackage ,package (:use)) + (eval-when (:compile-toplevel :load-toplevel :execute) + ,ensure-form)))) +;;;; Final tricks to keep various implementations happy. +;; We want most such tricks in common-lisp.lisp, +;; but these need to be done before the define-package form there, +;; that we nevertheless want to be the very first form. (eval-when (:load-toplevel :compile-toplevel :execute) - ;;; Before we do anything, some implementation-dependent tweaks - ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; NO: trust implementation defaults. - #+allegro + #+allegro ;; We need to disable autoloading BEFORE any mention of package ASDF. (setf excl::*autoload-package-name-alist* (remove "asdf" excl::*autoload-package-name-alist* - :test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below - #+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011 - (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all - (and (= system::*gcl-major-version* 2) - (< system::*gcl-minor-version* 7))) - (pushnew :gcl-pre2.7 *features*)) - #+(or abcl (and allegro ics) (and (or clisp cmu ecl mkcl) unicode) - clozure lispworks (and sbcl sb-unicode) scl) - (pushnew :asdf-unicode *features*) - ;;; make package if it doesn't exist yet. - ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it. - (unless (find-package :asdf) - (make-package :asdf :use '(:common-lisp)))) - -(in-package :asdf) - -(eval-when (:load-toplevel :compile-toplevel :execute) - ;;; This would belong amongst implementation-dependent tweaks above, - ;;; except that the defun has to be in package asdf. - #+ecl (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t)) - #+ecl (unless (use-ecl-byte-compiler-p) (require :cmp)) - #+mkcl (require :cmp) - #+mkcl (setq clos::*redefine-class-in-place* t) ;; Make sure we have strict ANSI class redefinition semantics - - ;;; Package setup, step 2. - (defvar *asdf-version* nil) - (defvar *upgraded-p* nil) - (defvar *asdf-verbose* nil) ; was t from 2.000 to 2.014.12. - (defun find-symbol* (s p) - (find-symbol (string s) p)) - ;; Strip out formatting that is not supported on Genera. - ;; Has to be inside the eval-when to make Lispworks happy (!) - (defun strcat (&rest strings) - (apply 'concatenate 'string strings)) - (defmacro compatfmt (format) - #-(or gcl genera) format - #+(or gcl genera) - (loop :for (unsupported . replacement) :in - (append - '(("~3i~_" . "")) - #+genera '(("~@<" . "") ("; ~@;" . "; ") ("~@:>" . "") ("~:>" . ""))) :do - (loop :for found = (search unsupported format) :while found :do - (setf format (strcat (subseq format 0 found) replacement - (subseq format (+ found (length unsupported))))))) - format) - (let* (;; For bug reporting sanity, please always bump this version when you modify this file. - ;; Please also modify asdf.asd to reflect this change. The script bin/bump-version - ;; can help you do these changes in synch (look at the source for documentation). - ;; Relying on its automation, the version is now redundantly present on top of this file. - ;; "2.345" would be an official release - ;; "2.345.6" would be a development version in the official upstream - ;; "2.345.0.7" would be your seventh local modification of official release 2.345 - ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26") - (existing-asdf (find-class 'component nil)) - (existing-version *asdf-version*) - (already-there (equal asdf-version existing-version))) - (unless (and existing-asdf already-there) - (when (and existing-asdf *asdf-verbose*) - (format *trace-output* - (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%") - existing-version asdf-version)) - (labels - ((present-symbol-p (symbol package) - (member (nth-value 1 (find-symbol* symbol package)) '(:internal :external))) - (present-symbols (package) - ;; #-genera (loop :for s :being :the :present-symbols :in package :collect s) #+genera - (let (l) - (do-symbols (s package) - (when (present-symbol-p s package) (push s l))) - (reverse l))) - (unlink-package (package) - (let ((u (find-package package))) - (when u - (ensure-unintern u (present-symbols u)) - (loop :for p :in (package-used-by-list u) :do - (unuse-package u p)) - (delete-package u)))) - (ensure-exists (name nicknames use) - (let ((previous - (remove-duplicates - (mapcar #'find-package (cons name nicknames)) - :from-end t))) - ;; do away with packages with conflicting (nick)names - (map () #'unlink-package (cdr previous)) - ;; reuse previous package with same name - (let ((p (car previous))) - (cond - (p - (rename-package p name nicknames) - (ensure-use p use) - p) - (t - (make-package name :nicknames nicknames :use use)))))) - (intern* (symbol package) - (intern (string symbol) package)) - (remove-symbol (symbol package) - (let ((sym (find-symbol* symbol package))) - (when sym - #-cormanlisp (unexport sym package) - (unintern sym package) - sym))) - (ensure-unintern (package symbols) - (loop :with packages = (list-all-packages) - :for sym :in symbols - :for removed = (remove-symbol sym package) - :when removed :do - (loop :for p :in packages :do - (when (eq removed (find-symbol* sym p)) - (unintern removed p))))) - (ensure-shadow (package symbols) - (shadow symbols package)) - (ensure-use (package use) - (dolist (used (package-use-list package)) - (unless (member (package-name used) use :test 'string=) - (unuse-package used) - (do-external-symbols (sym used) - (when (eq sym (find-symbol* sym package)) - (remove-symbol sym package))))) - (dolist (used (reverse use)) - (do-external-symbols (sym used) - (unless (eq sym (find-symbol* sym package)) - (remove-symbol sym package))) - (use-package used package))) - (ensure-fmakunbound (package symbols) - (loop :for name :in symbols - :for sym = (find-symbol* name package) - :when sym :do (fmakunbound sym))) - (ensure-export (package export) - (let ((formerly-exported-symbols nil) - (bothly-exported-symbols nil) - (newly-exported-symbols nil)) - (do-external-symbols (sym package) - (if (member sym export :test 'string-equal) - (push sym bothly-exported-symbols) - (push sym formerly-exported-symbols))) - (loop :for sym :in export :do - (unless (member sym bothly-exported-symbols :test 'equal) - (push sym newly-exported-symbols))) - (loop :for user :in (package-used-by-list package) - :for shadowing = (package-shadowing-symbols user) :do - (loop :for new :in newly-exported-symbols - :for old = (find-symbol* new user) - :when (and old (not (member old shadowing))) - :do (unintern old user))) - (loop :for x :in newly-exported-symbols :do - (export (intern* x package))))) - (ensure-package (name &key nicknames use unintern - shadow export redefined-functions) - (let* ((p (ensure-exists name nicknames use))) - (ensure-unintern p (append unintern #+cmu redefined-functions)) - (ensure-shadow p shadow) - (ensure-export p export) - #-cmu (ensure-fmakunbound p redefined-functions) - p))) - (macrolet - ((pkgdcl (name &key nicknames use export - redefined-functions unintern shadow) - `(ensure-package - ',name :nicknames ',nicknames :use ',use :export ',export - :shadow ',shadow - :unintern ',unintern - :redefined-functions ',redefined-functions))) - (pkgdcl - :asdf - :use (:common-lisp) - :redefined-functions - (#:perform #:explain #:output-files #:operation-done-p - #:perform-with-restarts #:component-relative-pathname - #:system-source-file #:operate #:find-component #:find-system - #:apply-output-translations #:translate-pathname* #:resolve-location - #:system-relative-pathname - #:inherit-source-registry #:process-source-registry - #:process-source-registry-directive - #:compile-file* #:source-file-type) - :unintern - (#:*asdf-revision* #:around #:asdf-method-combination - #:split #:make-collector #:do-dep #:do-one-dep - #:resolve-relative-location-component #:resolve-absolute-location-component - #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function - :export - (#:defsystem #:oos #:operate #:find-system #:locate-system #:run-shell-command - #:system-definition-pathname #:with-system-definitions - #:search-for-system-definition #:find-component #:component-find-path - #:compile-system #:load-system #:load-systems - #:require-system #:test-system #:clear-system - #:operation #:compile-op #:load-op #:load-source-op #:test-op - #:feature #:version #:version-satisfies - #:upgrade-asdf - #:implementation-identifier #:implementation-type #:hostname - #:input-files #:output-files #:output-file #:perform - #:operation-done-p #:explain - - #:component #:source-file - #:c-source-file #:cl-source-file #:java-source-file - #:cl-source-file.cl #:cl-source-file.lsp - #:static-file - #:doc-file - #:html-file - #:text-file - #:source-file-type - #:module ; components - #:system - #:unix-dso - - #:module-components ; component accessors - #:module-components-by-name - #:component-pathname - #:component-relative-pathname - #:component-name - #:component-version - #:component-parent - #:component-property - #:component-system - #:component-depends-on - #:component-encoding - #:component-external-format - - #:system-description - #:system-long-description - #:system-author - #:system-maintainer - #:system-license - #:system-licence - #:system-source-file - #:system-source-directory - #:system-relative-pathname - #:map-systems - - #:operation-description - #:operation-on-warnings - #:operation-on-failure - #:component-visited-p - - #:*system-definition-search-functions* ; variables - #:*central-registry* - #:*compile-file-warnings-behaviour* - #:*compile-file-failure-behaviour* - #:*resolve-symlinks* - #:*load-system-operation* - #:*asdf-verbose* - #:*verbose-out* - - #:asdf-version - - #:operation-error #:compile-failed #:compile-warned #:compile-error - #:error-name - #:error-pathname - #:load-system-definition-error - #:error-component #:error-operation - #:system-definition-error - #:missing-component - #:missing-component-of-version - #:missing-dependency - #:missing-dependency-of-version - #:circular-dependency ; errors - #:duplicate-names - - #:try-recompiling - #:retry - #:accept ; restarts - #:coerce-entry-to-directory - #:remove-entry-from-registry - - #:*encoding-detection-hook* - #:*encoding-external-format-hook* - #:*default-encoding* - #:*utf-8-external-format* - - #:clear-configuration - #:*output-translations-parameter* - #:initialize-output-translations - #:disable-output-translations - #:clear-output-translations - #:ensure-output-translations - #:apply-output-translations - #:compile-file* - #:compile-file-pathname* - #:enable-asdf-binary-locations-compatibility - #:*default-source-registries* - #:*source-registry-parameter* - #:initialize-source-registry - #:compute-source-registry - #:clear-source-registry - #:ensure-source-registry - #:process-source-registry - #:system-registered-p #:registered-systems #:loaded-systems - #:resolve-location - #:asdf-message - #:user-output-translations-pathname - #:system-output-translations-pathname - #:user-output-translations-directory-pathname - #:system-output-translations-directory-pathname - #:user-source-registry - #:system-source-registry - #:user-source-registry-directory - #:system-source-registry-directory - - ;; Utilities: please use asdf-utils instead - #| - ;; #:aif #:it - ;; #:appendf #:orf - #:length=n-p - #:remove-keys #:remove-keyword - #:first-char #:last-char #:string-suffix-p - #:coerce-name - #:directory-pathname-p #:ensure-directory-pathname - #:absolute-pathname-p #:ensure-pathname-absolute #:pathname-root - #:getenv #:getenv-pathname #:getenv-pathnames - #:getenv-absolute-directory #:getenv-absolute-directories - #:probe-file* - #:find-symbol* #:strcat - #:make-pathname-component-logical #:make-pathname-logical - #:merge-pathnames* #:coerce-pathname #:subpathname #:subpathname* - #:pathname-directory-pathname #:pathname-parent-directory-pathname - #:read-file-forms - #:resolve-symlinks #:truenamize - #:split-string - #:component-name-to-pathname-components - #:split-name-type - #:subdirectories #:directory-files - #:while-collecting - #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* - #:*wild-path* #:wilden - #:directorize-pathname-host-device|# - ))) - #+genera (import 'scl:boolean :asdf) - (setf *asdf-version* asdf-version - *upgraded-p* (if existing-version - (cons existing-version *upgraded-p*) - *upgraded-p*)))))) - + :test 'equalp :key 'car)) + #+gcl + ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, + ;; but can run ASDF 2.011. GCL 2.6 has even more issues. + (cond + ((or (< system::*gcl-major-version* 2) + (and (= system::*gcl-major-version* 2) + (< system::*gcl-minor-version* 6))) + (error "GCL 2.6 or later required to use ASDF")) + ((and (= system::*gcl-major-version* 2) + (= system::*gcl-minor-version* 6)) + (pushnew 'ignorable pcl::*variable-declarations-without-argument*) + (pushnew :gcl2.6 *features*)) + (t + (pushnew :gcl2.7 *features*)))) + +;; Compatibility with whoever calls asdf/package +(define-package :asdf/package (:use :cl :uiop/package) (:reexport :uiop/package)) ;;;; ------------------------------------------------------------------------- -;;;; User-visible parameters -;;;; -(defvar *resolve-symlinks* t - "Determine whether or not ASDF resolves symlinks when defining systems. - -Defaults to T.") - -(defvar *compile-file-warnings-behaviour* - (or #+clisp :ignore :warn) - "How should ASDF react if it encounters a warning when compiling a file? -Valid values are :error, :warn, and :ignore.") - -(defvar *compile-file-failure-behaviour* - (or #+sbcl :error #+clisp :ignore :warn) - "How should ASDF react if it encounters a failure (per the ANSI spec of COMPILE-FILE) -when compiling a file? Valid values are :error, :warn, and :ignore. -Note that ASDF ALWAYS raises an error if it fails to create an output file when compiling.") - -(defvar *verbose-out* nil) - -(defparameter +asdf-methods+ - '(perform-with-restarts perform explain output-files operation-done-p)) - -(defvar *load-system-operation* 'load-op - "Operation used by ASDF:LOAD-SYSTEM. By default, ASDF:LOAD-OP. -You may override it with e.g. ASDF:LOAD-FASL-OP from asdf-bundle, -or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.") - -(defvar *compile-op-compile-file-function* 'compile-file* - "Function used to compile lisp files.") - - +;;;; Handle compatibility with multiple implementations. +;;; This file is for papering over the deficiencies and peculiarities +;;; of various Common Lisp implementations. +;;; For implementation-specific access to the system, see os.lisp instead. +;;; A few functions are defined here, but actually exported from utility; +;;; from this package only common-lisp symbols are exported. + +(uiop/package:define-package :uiop/common-lisp + (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl) + (:use #-genera :common-lisp #+genera :future-common-lisp :uiop/package) + (:reexport :common-lisp) + (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf) + #+allegro (:intern #:*acl-warn-save*) + #+cormanlisp (:shadow #:user-homedir-pathname) + #+cormanlisp + (:export + #:logical-pathname #:translate-logical-pathname + #:make-broadcast-stream #:file-namestring) + #+gcl2.6 (:shadow #:type-of #:with-standard-io-syntax) ; causes errors when loading fasl(!) + #+gcl2.6 (:shadowing-import-from :system #:*load-pathname*) + #+genera (:shadowing-import-from :scl #:boolean) + #+genera (:export #:boolean #:ensure-directories-exist) + #+mcl (:shadow #:user-homedir-pathname)) +(in-package :uiop/common-lisp) + +#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl... [truncated message content] |