pax_global_header00006660000000000000000000000064125311234310014505gustar00rootroot0000000000000052 comment=6dab35052edde3a5785b9f56e260312481e291a0 asdf-finalizers-20150608-git/000077500000000000000000000000001253112343100156165ustar00rootroot00000000000000asdf-finalizers-20150608-git/.gitignore000066400000000000000000000000071253112343100176030ustar00rootroot00000000000000*.fasl asdf-finalizers-20150608-git/LICENSE000066400000000000000000000020551253112343100166250ustar00rootroot00000000000000Copyright (c) 2012-2012 Francois-Rene Rideau Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. asdf-finalizers-20150608-git/README000066400000000000000000000104361253112343100165020ustar00rootroot00000000000000ASDF-FINALIZERS This library allows you to implement and enforce proper finalization of compile-time constructs while building Lisp source files. It depends on ASDF 2.22.3 or later. TODO: * Add XCVB support. * Add SLIME support for proper :around-compile hooks. ==== Exported Functionality ==== asdf-finalizers defines and uses package ASDF-FINALIZERS. It uses ASDF 2.22.3's :around-compile hook mechanism and the :compile-check extension to its compile-file* to build stuff. macro FINAL-FORMS () This macro will expand into any final forms so far registered. The forms will be expanded inside an (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) ...) but you can override that with your own EVAL-WHEN. You need to have finalizers enabled to use this macro (see WITH-FINALIZERS). In a file that uses finalizers, you MUST include (FINAL-FORMS) after the last finalizer was used and before the end of the file, or the compilation will fail. Typically, you will write (FINAL-FORMS) as the very last form in your file, or if you didn't use the asdf-finalizers package, you will instead write (ASDF-FINALIZERS:FINAL-FORMS). function EVAL-AT-TOPLEVEL (FORM &optional ALREADY-DONE-P-FORM WARNING &rest WARNING-ARGUMENTS) This function, to be used within a macro, deftype, reader-macro, etc., will evaluate toplevel FORM now during the macroexpansion phase, but also register it to be evaluated at the toplevel as part of the FINAL-FORMS, so that assuming you use the FINAL-FORMS afterwards but before the end of current file, so it is available to whoever load the associated FASL or CFASL. If the FORM has already been registered, it is skipped. Either now or when loading the (C?)FASL, the evaluation of FORM will be skipped when ALREADY-DONE-P-FORM evaluates to a true value. When finalizers are not enabled, warn with given warning and arguments or with a default warning, unless ALREADY-DONE-P-FORM evaluated to a true value, at which point we trust the user to somehow have done the right thing, and a build from clean will hopefully catch him if he didn't. function REGISTER-FINAL-FORM (FORM) This function, to be used within a macro, reader-macro, deftype, etc., will register a constant piece of code to the evaluated at toplevel at the end of the current code fragment (e.g. file). function REGISTER-FINALIZER (THUNK) This function, to be used within a macro, reader-macro, deftype, etc., will register a THUNK to be called during finalization. Dependencies may be enforced by thunk calling thunk dependencies. Any form returned by the THUNK will be included in the finalized code after the code from any previously registered thunk of constant code fragment, and after the code from any registered dependency. macro WITH-FINALIZERS ((&key FINALIZE) &body BODY) Evaluate BODY in a context where finalizers are enabled. By default, don't finalize, because we want to catch code that fails to finalize in the same file that requires code finalization. This macro is typically used by ASDF when you configure it as below. For convenience, you may also use it to test code at the REPL; you may then pass an argument FINALIZE with true value, and WITH-FINALIZERS will evaluate finalization forms. function CHECK-FINALIZERS-AROUND-COMPILE (FUN) Assuming your system :depends-on (:asdf-finalizers), you may use this function as your :around-compile function for an ASDF system, module or file, as in :around-compile "asdf-finalizers:check-finalizers-around-compile" This will allow you to use finalizers within covered source files, and will issue an error if you fail to evaluate (FINAL-FORMS) after the last finalizer was used and before the end of the file. Alternatively, you may use ASDF::FINALIZED-CL-SOURCE-FILE below. You may also have your own custom :around-compile hooks chain into CHECK-FINALIZERS-AROUND-COMPILE to achieve the same effect and more. class ASDF::FINALIZED-CL-SOURCE-FILE (CL-SOURCE-FILE) Assuming your system :defsystem-depends-on (:asdf-finalizers), you may use this class as your system's :default-component-class, or as the class of a component as in (:finalized-cl-source-file "foo" :depends-on ("bar" "baz")) This will automatically declare CHECK-FINALIZERS-AROUND-COMPILE as the relevant component's :around-compile hook. asdf-finalizers-20150608-git/README.list-of000066400000000000000000000020651253112343100200550ustar00rootroot00000000000000LIST-OF This library exemplifies how to use ASDF-FINALIZERS, and offers a way to implement lists with a uniform type of elements. Because of its reliance on ASDF-FINALIZERS, any file that directly or indirectly (via macro-expansion) uses LIST-OF must include (ASDF-FINALIZERS:FINAL-FORMS) as its last form you probably want to have your package :use :asdf-finalizers, and you probably also need to in your defsystem to either :depends-on (:list-of) :around-compile "asdf-finalizers:check-finalizers-around-compile" or to :depends-on (:list-of) :defsystem-depends-on (:asdf-finalizers) :default-component-class :finalized-cl-source-file ==== Exported Functionality ==== LIST-OF defines the LIST-OF package from which it exports: DEFTYPE LIST-OF (TYPE) type of proper lists all of the elements of which are of given TYPE. Beware: the type checking predicate may never stop when fed a circular list. DEFTYPE VECTOR-OF (TYPE) type of vectors all of the elements of which are of given TYPE. The vector may be specialized as per UPGRADED-ARRAY-ELEMENT-TYPE. asdf-finalizers-20150608-git/asdf-finalizers-test.asd000066400000000000000000000016511253112343100223500ustar00rootroot00000000000000;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*- (defsystem "asdf-finalizers-test" :description "Tests for asdf-finalizers" :author "Francois-Rene Rideau" :depends-on ("asdf-finalizers-test/1" "asdf-finalizers-test/2") :perform (test-op (o c) (call-function "asdf-finalizers-test::test-suite"))) (defsystem "asdf-finalizers-test/1" :description "Some tests for asdf-finalizers" :author "Francois-Rene Rideau" :defsystem-depends-on ("asdf-finalizers") :around-compile "asdf-finalizers:check-finalizers-around-compile" :depends-on ("list-of" "fare-utils" "hu.dwim.stefil") :components ((:file "asdf-finalizers-test"))) (defsystem "asdf-finalizers-test/2" :description "Some tests for asdf-finalizers" :author "Francois-Rene Rideau" :defsystem-depends-on ("asdf-finalizers") :depends-on ("list-of" "fare-utils" "hu.dwim.stefil") :components ((:finalized-cl-source-file "asdf-finalizers-test"))) asdf-finalizers-20150608-git/asdf-finalizers-test.lisp000066400000000000000000000023661253112343100225540ustar00rootroot00000000000000#+xcvb (module (:depends-on ("asdf-finalizers" (:asdf "hu.dwim.stefil")))) (defpackage :asdf-finalizers-test (:use :cl :fare-utils :asdf-finalizers :hu.dwim.stefil :list-of)) (in-package :asdf-finalizers-test) ;;; Testing the asdf-finalizers library. (defsuite* (test-suite :in root-suite :documentation "Testing asdf-finalizers")) (defun transpose (x) (check-type x (list-of (list-of integer))) (apply 'mapcar 'list x)) (deftest test-list-of () (is (typep '(nil t t nil) '(list-of boolean))) (is (not (typep '(nil t 1 nil) '(list-of boolean)))) (is (not (typep '(nil t t nil . 1) '(list-of boolean)))) (is (typep '(1 2 3 4) '(list-of integer))) (is (not (typep '(1 2 3 4) '(list-of nil)))) (is (typep nil '(list-of nil))) (is (equal (transpose '((1 2) (3 4))) '((1 3) (2 4)))) nil) (typep '(1 2 3) '(list-of string)) (eval-when (:compile-toplevel :load-toplevel :execute) (typep '(1 2 3) '(list-of symbol))) (final-forms) #| Manual test: in a fresh Lisp, (require "asdf")(asdf:load-system :asdf-finalizers :force t)(trace asdf-finalizers:eval-at-toplevel asdf-finalizers:register-final-form)(setf asdf-finalizers::*debug-finalizers* t)(asdf:load-system :asdf-finalizers-test :force '(:asdf-finalizers-test)) |# asdf-finalizers-20150608-git/asdf-finalizers.asd000066400000000000000000000007611253112343100213740ustar00rootroot00000000000000;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*- (defsystem "asdf-finalizers" :description "Enforced calling of finalizers for Lisp code" :author "Francois-Rene Rideau" :depends-on ((:version "asdf" "3.0")) :components ((:file "pkgdcl") (:file "finalizers" :depends-on ("pkgdcl")) (:file "asdf-support" :depends-on ("finalizers")) ;; uses with-finalizers (:file "initialization" :depends-on ("pkgdcl"))) :in-order-to ((test-op (test-op "asdf-finalizers-test")))) asdf-finalizers-20150608-git/asdf-support.lisp000066400000000000000000000033251253112343100211410ustar00rootroot00000000000000#+xcvb (module (:depends-on ("finalizers"))) (in-package :asdf-finalizers) (defun compile-check-finalizers (input-file &rest keys &key &allow-other-keys) (declare (ignore keys)) (let ((okp (no-finalizer-left-behind-p))) (unless okp (warn 'missing-final-forms :format-control "Source file ~A uses finalizers but fails to ~ include ~S between the last finalizer and the end of file" :format-arguments `(,input-file (final-forms)))) okp)) (defun check-finalizers-around-compile (fun) "Assuming your system :depends-on (:asdf-finalizers), you may use this function as your :around-compile function for an ASDF system, module or file, as in :around-compile \"asdf-finalizers:check-finalizers-around-compile\" This will allow you to use finalizers within covered source files, and will issue an error if you fail to evaluate (FINAL-FORMS) after the last finalizer was used and before the end of the file. Alternatively, you may use ASDF::FINALIZED-CL-SOURCE-FILE below. You may also have your own custom :around-compile hooks chain into CHECK-FINALIZERS-AROUND-COMPILE to achieve the same effect and more." (with-finalizers () (funcall fun :compile-check 'compile-check-finalizers))) (defclass asdf::finalized-cl-source-file (cl-source-file) ((around-compile :initform 'check-finalizers-around-compile)) (:documentation "Assuming your system :defsystem-depends-on (:asdf-finalizers), you may use this class as your system's :default-component-class, or as the class of a component as in (:finalized-cl-source-file \"foo\" :depends-on (\"bar\" \"baz\")) This will automatically declare CHECK-FINALIZERS-AROUND-COMPILE as the relevant component's :around-compile hook.")) asdf-finalizers-20150608-git/build.xcvb000066400000000000000000000002721253112343100176020ustar00rootroot00000000000000;;-*- Lisp -*- (module (:fullname "asdf-finalizers" :build-depends-on ((:asdf "asdf")) :depends-on ("initialization") :supersedes-asdf ("asdf-finalizers" ("list-of" "list-of")))) asdf-finalizers-20150608-git/finalizers.lisp000066400000000000000000000156011253112343100206600ustar00rootroot00000000000000#+xcvb (module (:depends-on ("pkgdcl"))) (in-package :asdf-finalizers) (defvar *warn-when-finalizers-off* t "Flag to enable or disable the raising warnings when finalizers are used outside of context. Typically, you want that flag to be on while compiling your application, but off when your application is done compiled and you're at runtime.") (defvar *debug-finalizers* nil "Flag to enable debugging output for finalizers.") (define-condition finalizers-off () ()) (define-condition finalizers-off-error (finalizers-off error) ()) (define-condition finalizers-off-simple-error (finalizers-off-error simple-error) ()) (define-condition finalizers-off-warning (finalizers-off warning) ()) (define-condition finalizers-off-simple-warning (finalizers-off-warning simple-warning) ()) (define-condition missing-final-forms (simple-warning) ()) ;; UNBOUND by default: catch people using them outside of a proper with-finalizers form! (defvar *finalizers*) (defvar *finalizers-data* nil) (defun using-finalizers-p () (boundp '*finalizers*)) (defun reset-finalizers () (setf *finalizers* nil *finalizers-data* (make-hash-table :test 'equal)) (values)) (defun disable-finalizers () (makunbound '*finalizers*) (makunbound '*finalizers-data*) (values)) (defmacro final-forms () "This macro will expand into any final forms so far registered. The forms will be expanded inside an (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) ...) but you can override that with your own EVAL-WHEN. You need to have finalizers enabled to use this macro (see WITH-FINALIZERS). In a file that uses finalizers, you MUST include (FINAL-FORMS) after the last finalizer was used and before the end of the file, or the compilation will fail. Typically, you will write (FINAL-FORMS) as the very last form in your file, or if you didn't use the asdf-finalizers package, you will instead write (ASDF-FINALIZERS:FINAL-FORMS)." `(eval-when (:compile-toplevel :load-toplevel :execute) ;; This indirection is because some Lisps (e.g. CCL 1.8) may be confused ;; if the state from *finalizers* isn't properly flushed by this eval-when. (final-forms-internal))) (defmacro final-forms-internal () (expand-final-forms)) (defun expand-final-forms () (cond ((using-finalizers-p) (let ((forms (reverse (loop :while *finalizers* :collect (let ((f (pop *finalizers*))) (etypecase f (function (funcall f)) (cons f))))))) (when *debug-finalizers* (with-standard-io-syntax (let ((*package* (find-package :cl)) (*print-readably* nil) (*print-pretty* t)) (format *trace-output* "~&Final forms:~%~{ ~S~%~}~%" forms)))) `(progn ,@forms))) (*warn-when-finalizers-off* (warn 'finalizers-off-simple-warning :format-control "~S expanded outside of ~S" :format-arguments '(final-forms with-finalizers)) nil) (t nil))) (defun register-finalizer (finalizer) "This function, to be used within a macro, reader-macro, deftype, etc., will register a THUNK to be called during finalization. Dependencies may be enforced by thunk calling thunk dependencies. Any form returned by the THUNK will be included in the finalized code after the code from any previously registered thunk of constant code fragment, and after the code from any registered dependency." (check-type finalizer (or function cons)) (unless (using-finalizers-p) (error 'finalizers-off-simple-error :format-control "Trying to use finalizers outside of a (~S ...) form. ~ You probably need to use ~ :around-compile \"asdf-finalizers:check-finalizers-around-compile\" ~ in your asdf defsystem" :format-arguments '(with-finalizers))) (push finalizer *finalizers*)) (defun register-final-form (form) "This function, to be used within a macro, reader-macro, deftype, etc., will register a constant piece of code to the evaluated at toplevel at the end of the current code fragment (e.g. file)." (check-type form cons) (register-finalizer form)) (defun no-finalizer-left-behind-p () (null *finalizers*)) (defun assert-no-finalizer-left-behind () (assert (no-finalizer-left-behind-p))) (defmacro with-finalizers ((&key finalize) &body body) "Evaluate BODY in a context where finalizers are enabled. By default, don't finalize, because we want to catch code that fails to finalize in the same file that requires code finalization. This macro is typically used by ASDF when you configure it as below. For convenience, you may also use it to test code at the REPL; you may then pass an argument FINALIZE with true value, and WITH-FINALIZERS will evaluate finalization forms." `(call-with-finalizers #'(lambda () ,@body) :finalize ,finalize)) (defun call-with-finalizers (thunk &key finalize) (let ((*finalizers* '()) (*finalizers-data* (make-hash-table :test 'equal))) (unwind-protect (funcall thunk) (when finalize (eval '(final-forms))) (assert-no-finalizer-left-behind)))) (defun eval-at-toplevel (form &optional already-done-p-form warning &rest warning-arguments) "This function, to be used within a macro, deftype, reader-macro, etc., will evaluate toplevel FORM now during the macroexpansion phase, but also register it to be evaluated at the toplevel as part of the FINAL-FORMS, so that assuming you use the FINAL-FORMS afterwards but before the end of current file, so it is available to whoever load the associated FASL or CFASL. If the FORM has already been registered, it is skipped. Either now or when loading the (C?)FASL, the evaluation of FORM will be skipped when ALREADY-DONE-P-FORM evaluates to a true value. When finalizers are not enabled, warn with given warning and arguments or with a default warning, unless ALREADY-DONE-P-FORM evaluated to a true value, at which point we trust the user to somehow have done the right thing, and a build from clean will hopefully catch him if he didn't." (let ((whole `(eval-at-toplevel ,form ,already-done-p-form)) (already-done-p (eval already-done-p-form))) (unless already-done-p (eval form)) (cond ((using-finalizers-p) (unless (gethash whole *finalizers-data*) (setf (gethash whole *finalizers-data*) t) (register-final-form (if already-done-p-form `(unless ,already-done-p-form ,form) form)))) (already-done-p) ;; don't warn if it has already been done; it could be by design. ((not *warn-when-finalizers-off*)) ;; don't warn if warnings are off - e.g. at runtime. ((stringp warning) (warn 'finalizers-off-simple-warning :format-control warning :format-arguments warning-arguments)) ((and warning (symbolp warning)) (apply 'warn warning warning-arguments)) (t (warn 'finalizers-off-simple-warning :format-control "trying to ~S form ~S without finalizers enabled~@[ while not ~S~]" :format-arguments whole)))) nil) asdf-finalizers-20150608-git/initialization.lisp000066400000000000000000000001731253112343100215370ustar00rootroot00000000000000#+xcvb (module (:depends-on ("finalizers" "asdf-support"))) ;;; Load-time Initialization. (in-package :asdf-finalizers) asdf-finalizers-20150608-git/list-of.asd000066400000000000000000000003401253112343100176610ustar00rootroot00000000000000;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*- (defsystem "list-of" :description "magic list-of deftype" :author "Francois-Rene Rideau" :depends-on ("asdf-finalizers") :components ((:file "list-of"))) asdf-finalizers-20150608-git/list-of.lisp000066400000000000000000000056631253112343100200760ustar00rootroot00000000000000#+xcvb (module (:depends-on ("initialization"))) (defpackage :list-of (:use :cl :asdf-finalizers) (:export #:list-of #:vector-of)) (in-package :list-of) (defun sequence-of-predicate-for (type &optional (sequence-type 'list)) (with-standard-io-syntax (let ((*package* (find-package :list-of))) (intern (format nil "~S-OF-~S-P" sequence-type type) :list-of)))) (defun list-of-predicate-for (type) (sequence-of-predicate-for type 'list)) (defun vector-of-predicate-for (type) (sequence-of-predicate-for type 'vector)) (defun list-of-type-predicate (type) #'(lambda (x) (loop :for c = x :then (cdr c) :while (consp c) :always (typep (car c) type) :finally (return (null c))))) (defun vector-of-type-predicate (type) #'(lambda (x) (and (typep x 'vector) (every #'(lambda (e) (typep e type)) x)))) (defun ensure-list-of-predicate (type &optional predicate) (unless predicate (setf predicate (list-of-predicate-for type))) (check-type predicate symbol) (unless (fboundp predicate) (setf (symbol-function predicate) (list-of-type-predicate type))) nil) (defun ensure-vector-of-predicate (type &optional predicate) (unless predicate (setf predicate (vector-of-predicate-for type))) (check-type predicate symbol) (unless (fboundp predicate) (setf (symbol-function predicate) (vector-of-type-predicate type))) nil) (deftype list-of (type) (case type ((t) 'list) ;; a (list-of t) is the same as a regular list. ((nil) 'null) ;; a (list-of nil) can have no elements, it's null. (otherwise (let ((predicate (list-of-predicate-for type))) (eval-at-toplevel ;; now, and amongst final-forms if enabled `(ensure-list-of-predicate ',type ',predicate) `(fboundp ',predicate) ;; hush unnecessary eval-at-toplevel warnings "Defining ~S outside of finalized Lisp code" `(list-of ,type)) `(and list (satisfies ,predicate)))))) (deftype vector-of (type) (let ((spec-type (upgraded-array-element-type type))) (if (equal type spec-type) `(vector ,spec-type) (let ((predicate (vector-of-predicate-for type))) (eval-at-toplevel ;; now, and amongst final-forms if enabled `(ensure-vector-of-predicate ',type ',predicate) `(fboundp ',predicate) ;; hush unnecessary eval-at-toplevel warnings "Defining ~S outside of finalized Lisp code" `(vector-of ,type)) `(and (vector ,spec-type) (satisfies ,predicate)))))) ;; These are available in case you prefer to explicitly call declare-list-of and ;; declare-vector-of in your code-base rather than rely on finalizers. ;; They are not exported because we do not encourage it, but you can import them. (defmacro declare-list-of (type) `(eval-when (:compile-toplevel :load-toplevel :execute) (ensure-list-of-predicate ',type))) (defmacro declare-vector-of (type) `(eval-when (:compile-toplevel :load-toplevel :execute) (ensure-vector-of-predicate ',type))) asdf-finalizers-20150608-git/pkgdcl.lisp000066400000000000000000000010741253112343100177550ustar00rootroot00000000000000#+xcvb (module ()) (in-package :cl) (defpackage :asdf-finalizers (:use :cl :asdf) (:export #:*warn-when-finalizers-off* #:eval-at-toplevel #:final-forms #:register-finalizer #:register-final-form #:no-finalizer-left-behind-p #:assert-no-finalizer-left-behind #:compile-check-finalizers #:check-finalizers-around-compile #:call-with-finalizers #:with-finalizers #:using-finalizers-p #:finalizers-off #:finalizers-off-error #:finalizers-off-simple-error #:finalizers-off-warning #:finalizers-off-simple-warning ))