Commit 0a6a0e77 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'master' into 'master'

Two more changes for Genera

See merge request asdf/asdf!172
parents 6e2df328 d6d7d423
......@@ -556,7 +556,7 @@ which is probably not what you want; you probably need to tweak your output tran
(defmethod component-depends-on :around ((o image-op) (c system))
(let* ((next (call-next-method))
(deps (make-hash-table :test 'equal))
(linkable (loop* :for (do . dcs) :in next :collect
(linkable (loop :for (do . dcs) :in next :collect
(cons do
(loop :for dc :in dcs
:for dep = (and dc (resolve-dependency-spec c dc))
......@@ -68,7 +68,7 @@
(defmethod component-depends-on ((o define-op) (s system))
`(;;NB: 1- ,@(system-defsystem-depends-on s)) ; Should be already included in the below.
;; 2- We don't call-next-method to avoid other methods
,@(loop* :for (o . c) :in (definition-dependency-list s) :collect (list o c))))
,@(loop :for (o . c) :in (definition-dependency-list s) :collect (list o c))))
(defmethod component-depends-on ((o operation) (s system))
`(,@(when (and (not (typep o 'define-op))
;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; Package: CL-USER ; buffer-read-only: t; -*-
;;; This is ASDF Another System Definition Facility.
;;; Feedback, bug reports, and patches are all welcome:
......@@ -293,7 +293,7 @@ effectively disabling the output translation facility."
((or pathname string)
(loop* :with p = (resolve-symlinks* path)
(loop :with p = (resolve-symlinks* path)
:for (source destination) :in (car *output-translations*)
:for root = (when (or (eq source t)
(and (pathnamep source)
......@@ -69,7 +69,7 @@ the DEFPACKAGE-FORM uses it or imports a symbol from it."
(assert (defpackage-form-p defpackage-form))
(while-collecting (dep)
(loop* :for (option . arguments) :in (cddr defpackage-form) :do
(loop :for (option . arguments) :in (cddr defpackage-form) :do
(ecase option
((:use :mix :reexport :use-reexport :mix-reexport)
(dolist (p arguments) (dep (string p))))
......@@ -77,7 +77,7 @@ the DEFPACKAGE-FORM uses it or imports a symbol from it."
(dep (string (first arguments))))
(loop* :for (nil actual-package-name) :in arguments :do
(loop :for (nil actual-package-name) :in arguments :do
(dep (string actual-package-name))))
((:nicknames :documentation :shadow :export :intern :unintern :recycle)))))
:from-end t :test 'equal))
......@@ -195,7 +195,7 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
(defun %define-component-inline-methods (ret rest)
;; find key-value pairs that look like inline method definitions in REST. For each identified
;; definition, parse it and, if it is well-formed, define the method.
(loop* :for (key value) :on rest :by #'cddr
(loop :for (key value) :on rest :by #'cddr
:for name = (and (keywordp key) (find key +asdf-methods+ :test 'string=))
:when name :do
;; parse VALUE as an inline method definition of the form
......@@ -220,7 +220,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
(with-upgradability ()
(defun* (map-direct-dependencies) (operation component fun)
"Call FUN on all the valid dependencies of the given action in the given plan"
(loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
(loop :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
:for dep-o = (find-operation operation dep-o-spec)
:when dep-o
:do (loop :for dep-c-spec :in dep-c-specs
......@@ -166,13 +166,6 @@
(setq clos::*redefine-class-in-place* t)) ;; Make sure we have strict ANSI class redefinition semantics
;;;; Looping
(eval-when (:load-toplevel :compile-toplevel :execute)
(defmacro loop* (&rest rest)
#-genera `(loop ,@rest)
#+genera `(lisp:loop ,@rest))) ;; In genera, CL:LOOP can't destructure, so we use LOOP*. Sigh.
;;;; compatfmt: avoid fancy format directives when unsupported
(eval-when (:load-toplevel :compile-toplevel :execute)
(defun frob-substrings (string substrings &optional frob)
......@@ -218,7 +218,7 @@ directive.")
(defun* (resolve-location) (x &key ensure-directory wilden directory)
"Resolve location designator X into a PATHNAME"
;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory
(loop* :with dirp = (or directory ensure-directory)
(loop :with dirp = (or directory ensure-directory)
:with (first . rest) = (if (atom x) (list x) x)
:with path = (or (resolve-absolute-location
first :ensure-directory (and (or dirp rest) t)
......@@ -66,7 +66,7 @@ keywords explicitly."
(defun detect-os ()
"Detects the current operating system. Only needs be run at compile-time,
except on ABCL where it might change between FASL compilation and runtime."
(loop* :with o
(loop :with o
:for (feature . detect) :in '((:os-unix . os-unix-p) (:os-macosx . os-macosx-p)
(:os-windows . os-windows-p)
(:os-genera . os-genera-p) (:os-oldmac . os-oldmac-p)
......@@ -81,7 +81,7 @@ that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port
(defmacro os-cond (&rest clauses)
#+abcl `(cond ,@clauses)
#-abcl (loop* :for (test . body) :in clauses :when (eval test) :return `(progn ,@body)))
#-abcl (loop :for (test . body) :in clauses :when (eval test) :return `(progn ,@body)))
......@@ -352,7 +352,7 @@ If LINEWISE is true, then read and copy the stream line by line, with an optiona
Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE."
(with-open-stream (input input)
(if linewise
(loop* :for (line eof) = (multiple-value-list (read-line input nil nil))
(loop :for (line eof) = (multiple-value-list (read-line input nil nil))
:while line :do
(when prefix (princ prefix output))
(princ line output)
......@@ -4,9 +4,9 @@
(uiop/package:define-package :uiop/utility
(:use :uiop/common-lisp :uiop/package)
;; import and reexport a few things defined in :uiop/common-lisp
(:import-from :uiop/common-lisp #:compatfmt #:loop* #:frob-substrings
(:import-from :uiop/common-lisp #:compatfmt #:frob-substrings
#+(or clasp ecl) #:use-ecl-byte-compiler-p #+mcl #:probe-posix)
(:export #:compatfmt #:loop* #:frob-substrings #:compatfmt
(:export #:compatfmt #:frob-substrings #:compatfmt
#+(or clasp ecl) #:use-ecl-byte-compiler-p #+mcl #:probe-posix)
;; magic helper to define debugging functions:
......@@ -185,13 +185,13 @@ Returns two values: \(A B C\) and \(1 2 3\)."
(with-upgradability ()
(defun remove-plist-key (key plist)
"Remove a single key from a plist"
(loop* :for (k v) :on plist :by #'cddr
(loop :for (k v) :on plist :by #'cddr
:unless (eq k key)
:append (list k v)))
(defun remove-plist-keys (keys plist)
"Remove a list of keys from a plist"
(loop* :for (k v) :on plist :by #'cddr
(loop :for (k v) :on plist :by #'cddr
:unless (member k keys)
:append (list k v))))
......@@ -209,7 +209,7 @@ Returns two values: \(A B C\) and \(1 2 3\)."
;; NB: We assume a total order on character types.
;; If that's not true... this code will need to be updated.
(defparameter +character-types+ ;; assuming a simple hierarchy
#.(coerce (loop* :for (type next) :on
#.(coerce (loop :for (type next) :on
'(;; In SCL, all characters seem to be 16-bit base-char
;; Yet somehow character fails to be a subtype of base-char
#-scl base-char
......@@ -139,7 +139,7 @@ previously-loaded version of ASDF."
(if (consp x) (values (car x) (cadr x)) (values x :asdf))
(find-symbol* s p nil)))
(asyms (l) (mapcar #'asym l)))
(loop* :for (name superclasses slots) :in redefined-classes
(loop :for (name superclasses slots) :in redefined-classes
:for sym = (find-symbol* name :asdf nil)
:when (and sym (find-class sym))
:do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment