operation.lisp 3.3 KB
Newer Older
1 2 3
;;;; -------------------------------------------------------------------------
;;;; Operations

4
(uiop/package:define-package :asdf/operation
5
  (:recycle :asdf/operation :asdf/action :asdf) ;; asdf/action for FEATURE pre 2.31.5.
6
  (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session)
7 8
  (:export
   #:operation
9 10
   #:*operations* #:make-operation #:find-operation
   #:feature)) ;; TODO: stop exporting the deprecated FEATURE feature.
11 12 13
(in-package :asdf/operation)

;;; Operation Classes
14
(when-upgrading (:version "2.27" :when (find-class 'operation nil))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
15 16 17
  ;; override any obsolete shared-initialize method when upgrading from ASDF2.
  (defmethod shared-initialize :after ((o operation) (slot-names t) &key)
    (values)))
18

19 20
(with-upgradability ()
  (defclass operation ()
21
    ()
22
    (:documentation "The base class for all ASDF operations.
23

24 25
ASDF does NOT and never did distinguish between multiple operations of the same class.
Therefore, all slots of all operations MUST have :allocation :class and no initargs. No exceptions.
26 27
"))

28 29 30 31 32 33 34
  (defvar *in-make-operation* nil)

  (defun check-operation-constructor ()
    "Enforce that OPERATION instances must be created with MAKE-OPERATION."
    (unless *in-make-operation*
      (sysdef-error "OPERATION instances must only be created through MAKE-OPERATION.")))

35
  (defmethod print-object ((o operation) stream)
36 37 38
    (print-unreadable-object (o stream :type t :identity nil)))

  ;;; Override previous methods (from 3.1.7 and earlier) and add proper error checking.
39
  #-genera ;; Genera adds its own system initargs, e.g. clos-internals:storage-area 8
40 41 42 43
  (defmethod initialize-instance :after ((o operation) &rest initargs &key &allow-other-keys)
    (unless (null initargs)
      (parameter-error "~S does not accept initargs" 'operation))))

44 45 46

;;; make-operation, find-operation

47
(with-upgradability ()
48
  ;; A table to memoize instances of a given operation. There shall be only one.
49 50
  (defparameter* *operations* (make-hash-table :test 'equal))

51
  ;; A memoizing way of creating instances of operation.
52
  (defun make-operation (operation-class)
53
    "This function creates and memoizes an instance of OPERATION-CLASS.
54
All operation instances MUST be created through this function.
55

56
Use of INITARGS is not supported at this time."
57
    (let ((class (coerce-class operation-class
58 59
                               :package :asdf/interface :super 'operation :error 'sysdef-error))
          (*in-make-operation* t))
60
      (ensure-gethash class *operations* `(make-instance ,class))))
61

62 63 64 65
  ;; This function is mostly for backward and forward compatibility:
  ;; operations used to preserve the operation-original-initargs of the context,
  ;; and may in the future preserve some operation-canonical-initargs.
  ;; Still, the treatment of NIL as a disabling context is useful in some cases.
66 67
  (defgeneric find-operation (context spec)
    (:documentation "Find an operation by resolving the SPEC in the CONTEXT"))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
68
  (defmethod find-operation ((context t) (spec operation))
69
    spec)
70
  (defmethod find-operation ((context t) (spec symbol))
71
    (when spec ;; NIL designates itself, i.e. absence of operation
72 73 74
      (make-operation spec))) ;; TODO: preserve the (operation-canonical-initargs context)
  (defmethod find-operation ((context t) (spec string))
    (make-operation spec))) ;; TODO: preserve the (operation-canonical-initargs context)
75