Commit ae3b26b1 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Merge some fixes back from the fare-3.1 branch:

* override for prepare-op is on component-depends-on, not perform.
* coerce-class must be defined after call-function, and accept *package* for now.
parent 63136fdc
......@@ -56,7 +56,6 @@
(component 'component)
(opix (position operation formals))
(coix (position component formals))
(prefix (subseq formals 0 opix))
(suffix (subseq formals (1+ coix) len))
(more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
......
......@@ -110,7 +110,7 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.
The default operation may change in the future if we implement a
component-directed strategy for how to load or compile systems.")
(defmethod perform ((o prepare-op) (s system))
(defmethod component-depends-on ((o prepare-op) (s system))
`((,*load-system-operation* ,@(component-sideway-dependencies s))))
(defclass build-op (non-propagating-operation) ()
......
......@@ -331,34 +331,6 @@ the two results passed to STRCAT always reconstitute the original string"
(when x (c +crlf+) (c +lf+) (c +cr+) (values x nil)))))
;;; CLOS
(with-upgradability ()
(defun coerce-class (class &key (package :cl) (super t) (error 'error))
"Coerce CLASS to a class that is subclass of SUPER if specified,
or invoke ERROR handler as per CALL-FUNCTION.
A keyword designates the name a symbol, which when found in PACKAGE, designates a class.
A string is read as a symbol while in PACKAGE, the symbol designates a class.
A class object designates itself.
NIL designates itself (no class).
A symbol otherwise designates a class by name."
(let* ((normalized
(typecase class
(keyword (find-symbol* class package nil))
(string (symbol-call :uiop :safe-read-from-string class :package package))
(t class)))
(found
(etypecase normalized
((or standard-class built-in-class) normalized)
((or null keyword) nil)
(symbol (find-class normalized nil nil)))))
(or (and found
(or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
found)
(call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity
(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
(deftype stamp () '(or real boolean)))
......@@ -457,6 +429,36 @@ When CALL-NOW-P is true, also call the function immediately."
(when call-now-p (call-function hook))))
;;; CLOS
(with-upgradability ()
(defun coerce-class (class &key (package :cl) (super t) (error 'error))
"Coerce CLASS to a class that is subclass of SUPER if specified,
or invoke ERROR handler as per CALL-FUNCTION.
A keyword designates the name a symbol, which when found in either PACKAGE, designates a class.
-- for backward compatibility, *PACKAGE* is also accepted for now, but this may go in the future.
A string is read as a symbol while in PACKAGE, the symbol designates a class.
A class object designates itself.
NIL designates itself (no class).
A symbol otherwise designates a class by name."
(let* ((normalized
(typecase class
(keyword (or (find-symbol* class package nil)
(find-symbol* class *package* nil)))
(string (symbol-call :uiop :safe-read-from-string class :package package))
(t class)))
(found
(etypecase normalized
((or standard-class built-in-class) normalized)
((or null keyword) nil)
(symbol (find-class normalized nil nil)))))
(or (and found
(or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
found)
(call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
;;; Hash-tables
(with-upgradability ()
(defun ensure-gethash (key table default)
......
Markdown is supported
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