Thu Mar 8 05:15:58 UTC 2012 pix@kepibu.org
* Rename notes.org to README.org
Mon Jul 20 18:34:17 UTC 2009 pix@kepibu.org
* see other links, and add reference to cl-syntax-sugar
Mon Jul 20 07:07:16 UTC 2009 pix@kepibu.org
* Some org-mode syntaxisms
Mon Jul 20 06:58:45 UTC 2009 pix@kepibu.org
* Update bug list to include reader bug
Mon Jul 20 01:31:17 UTC 2009 pix@kepibu.org
tagged VERSION 0.1.3
Mon Jul 20 01:31:10 UTC 2009 pix@kepibu.org
* Bump version
Mon Jul 20 01:14:10 UTC 2009 pix@kepibu.org
* Improved feature readers
It turns out #+/#- also need to do their thing under *read-suppress*, rather
than simply skipping two forms.
E.g.,
'(#+(or) #+(not a b) a b c) => '(c)
'(#+(or) #+(and) a b c) => '(b c)
(Not that such constructions are practically portable anyway, but meh.)
Regardless, this fixes that as best I can. Unfortunately, it also forces
the normal package problems within feature expressions:
#+(or) #+(notapackage:foo) 'a => PACKAGE-ERROR
#+(or) #+(cl:notexported) 'a => PACKAGE-ERROR
This is, so far as I can tell, portably unavoidable. However, some (all?)
implementations /already/ have this problem, so at least it's nothing new.
Mon Jul 20 01:09:25 UTC 2009 pix@kepibu.org
* Better reporting of undefined-feature-tests.
Sun Jul 19 13:58:44 UTC 2009 pix@kepibu.org
tagged VERSION 0.1.2
Sun Jul 19 13:58:33 UTC 2009 pix@kepibu.org
* Bump version
Sun Jul 19 13:58:20 UTC 2009 pix@kepibu.org
* Use consp to avoid treating nil as a list
Sun Jul 19 12:31:43 UTC 2009 pix@kepibu.org
tagged VERSION 0.1.1
Sun Jul 19 12:28:28 UTC 2009 pix@kepibu.org
* Take *read-suppress* into account
Sun Jul 19 12:27:37 UTC 2009 pix@kepibu.org
* Minor changes to the notes file
Fri Jul 17 05:24:52 UTC 2009 pix@kepibu.org
* Initial checkin
diff -rN -u old-portaCL/README.org new-portaCL/README.org
--- old-portaCL/README.org 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/README.org 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,119 @@
+#+TITLE: PortaCL: Easing the Creation of CL Portability Libraries
+
+* Rationale
+
+Sometimes you want to do something based upon *features*. Often, that results
+in lots of reader conditionals, and a final reader conditional duplicating and
+negating all previous conditionals. Ew!
+
+* API
+
+** ASDF Components: port-file, port-module
+
+It's not uncommon for a portability library to include something like:
+ :(:file
+ : #+sbcl "port-sbcl"
+ : #+clisp "port-clisp"
+ : #-(or sbcl clisp) (error "not supported"))
+port-file and port-modules allow you to specify things more like so:
+ :(:port-file "port-~A")
+or, less positionally,
+ :(:port-file "port-~/implementation/")
+
+Whether such magical divinations are a good thing is left to you to decide.
+
+port-file and port-module both also support specification of an :alternate-file,
+which if specified will be used in place of throwing a not-implemented error.
+E.g., for use if only one or two implementations need special behavior.
+
+You can also specify :not-found-condition, the condition type which will be
+thrown if no applicable file is found. (e.g., you might prefer 'not-supported
+instead, or 'not-necessary if a missing component is okay).
+
+** Condition: not-implemented
+
+Useful for indicating a particular thing is not implemented.
+
+This is the default condition thrown when an implementation-specific ASDF
+component is not found.
+
+** Condition: not-supported
+
+A particular thing is not implemented and won't be. E.g., because the lisp
+implementation lacks the necessary features.
+
+** Condition: not-necessary
+
+If this thing is not implemented, it didn't need to be.
+
+When specified as the :not-found-condition in a defsystem form, will cause
+operations on the component to be considered successful even if the component
+could not be found.
+
+** Function: featurep feature-expression
+
+Given a feature expression, returns true if that expression is true.
+
+see [[http://www.lispworks.com/documentation/HyperSpec/Body/24_aba.htm][CLHS 24.1.2.1]] for details.
+
+** Macro: define-feature-test test-name-or-names lambda-list [documentation] &body
+
+Defines a feature test which shall return true if the given feature expressions apply.
+
+see [[http://repo.kepibu.org/portaCL/feature-tests.lisp][feature-tests.lisp]] for usage examples.
+
+** Macro: feature-cond ([feature-conditional] [clause]+)*
+
+A macro version of #+foo (thing) #+bar (thing2) #-(or foo bar) (no-thing), with
+all the caveats and shortcomings that implies.
+
+** Macro: feature-ecase ([[feature-conditional] [clause]+]+)
+
+feature-case, except always includes a final (error 'not-implemented).
+
+* Future Ideas
+
+** ASDF component enhancements
+*** platform / operating system
+
+It might be useful to also offer up the operating system for interpolation into
+port-files. (e.g., via ~/platform/ or ~/operating-system/).
+
+*** shared-implementation support
+
+It might also be useful to offer a way to specify that certain implementations
+should be treated just like another implementation. E.g.,
+ :(:port-file "port-~a" :treat-as (:ecl :sbcl))
+could be used by usocket, instead of futzing with :alternate-file.
+
+** Other porting styles?
+
+Per-file implementation is not the only possible or used porting approach.
+Perhaps some others should also be supported?
+
+ * SLIME's defimplementation
+ * Xach's CLOS-based approach
+ * Any others?
+
+* Bugs
+
+ * ASDF systems sometimes try to recursively load themselves a couple
+ hundred times. (Though I've seen that even without loading portaCL, so
+ may not be entirely my bug...)
+ * Constructs similar to the ones below will result in an incorrect
+ package-error:
+ :(list #+(or) #+package:notexported a b c)
+ :(list #+(or) #+notapackage:foo a b c)
+ NOTE: this bug is shared by the standard readers of at least SBCL,
+ Clisp, and Lispworks; but not by Allegro.
+
+* see also
+
+[[http://www.cliki.net/trivial-features][trivial-features]]
+ smooths out the unnecessary differences between implementation *features*
+[[http://common-lisp.net/project/alexandria/][alexandria]]
+ implements a #'featurep which exactly matches that used by the standard's
+ #+/#- readmacros.
+[[http://common-lisp.net/project/cl-syntax-sugar/][cl-syntax-sugar]]
+ Offers a feature-case reader which is almost certainly more useful than
+ portaCL's feature-cond macro.
diff -rN -u old-portaCL/asdf-components.lisp new-portaCL/asdf-components.lisp
--- old-portaCL/asdf-components.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/asdf-components.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,69 @@
+(in-package #:portaCL)
+
+(defclass port-mixin ()
+ ((format-name :initform ""
+ :initarg :format-name
+ :accessor format-name)
+ (alternate-file :initform nil
+ :initarg :alternate-file
+ :accessor alternate-file)
+ (not-found-condition :initform 'not-implemented
+ :initarg :not-found-condition
+ :accessor not-found-condition))
+ (:documentation "Like cl-source-file, but offers the ability to splice the
+ implementation type into the name."))
+
+(defclass port-file (port-mixin asdf:cl-source-file) ())
+(defclass port-module (port-mixin asdf:module) ())
+
+;; ASDF does instantiation kinda funky.
+(defmethod reinitialize-instance :after ((port-component port-mixin) &key name alternate-file &allow-other-keys)
+ (when name
+ (setf (format-name port-component)
+ name))
+ (when alternate-file
+ (setf (alternate-file port-component)
+ (merge-pathnames alternate-file (asdf::component-parent-pathname port-component)))))
+
+;; SPOOKY! component-pathname defaults to using the component-name. We take
+;; advantage of that to provide an implementation-dependent pathname while
+;; leaving the component name as the original format string.
+(defmethod asdf:component-name ((port port-mixin))
+ (if *implementation*
+ (format nil (format-name port) *implementation*)
+ (format-name port)))
+
+;; Beware the nearly duplicate code in the following two methods. It's not
+;; really worth factoring out, so be sure to make changes in both.
+(defmethod asdf:component-pathname ((port port-module))
+ (or (first (some #'directory
+ (loop :for *implementation* :in (lisp-implementation-names)
+ :collect (call-next-method))))
+ (and (alternate-file port)
+ (directory (alternate-file port)))
+ (error (not-found-condition port))))
+
+(defmethod asdf:component-pathname ((port port-file))
+ (or (some #'probe-file
+ (loop :for *implementation* :in (lisp-implementation-names)
+ :collect (call-next-method)))
+ (and (alternate-file port)
+ (probe-file (alternate-file port)))
+ (error (not-found-condition port))))
+
+;; If the component is unnecessary, then no worries mate. And yes, both of
+;; these methods are necessary.
+(defmethod asdf:operation-done-p :around ((o asdf:operation) (component port-mixin))
+ (handler-case (call-next-method)
+ (not-necessary () t)))
+(defmethod asdf:perform :around ((operation asdf:operation) (component port-mixin))
+ (handler-case (call-next-method)
+ (not-necessary () t)))
+
+;; Make :port-file work in system definitions
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import 'port-file :asdf)
+ (import 'port-module :asdf))
+
+;; testing examples
+#+nil (pushnew #p"l:/clbuild/source/portaCL/examples/" asdf::*subdir-search-registry*)
diff -rN -u old-portaCL/conditions.lisp new-portaCL/conditions.lisp
--- old-portaCL/conditions.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/conditions.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,14 @@
+(in-package #:portaCL)
+
+(define-condition not-implemented (error) ()
+ (:documentation "Condition for when an implementation has not been written,
+ but not deliberately excluded. This is generally the default."))
+
+(define-condition not-supported (error) ()
+ (:documentation "Condition for when something is deliberately not
+ supported."))
+
+(define-condition not-necessary () ()
+ (:documentation "Condition for when something is not necessary. E.g., setting
+ this in an .ASD file will cause that particular component to load only if it
+ exists, while preventing failure if it does not."))
diff -rN -u old-portaCL/control-flow.lisp new-portaCL/control-flow.lisp
--- old-portaCL/control-flow.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/control-flow.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,89 @@
+(in-package #:portaCL)
+
+(defmacro feature-cond (&body clauses)
+ "Some things are best shown by example. Suppose you have:
+ #+clisp (do-clisp-thing-1)
+ #+clisp (do-clisp-thing-2)
+ #+sbcl (do-sbcl-thing)
+ #-(or clisp sbcl) (error \"not implemented\")
+Using feature-cond, that would be:
+ (feature-cond
+ (:clisp (do-clisp-thing-1)
+ (do-clisp-thing-2))
+ (:sbcl (do-sbcl-thing))
+ (t (error \"not implemented\")))
+
+Accordingly, putting cl:t into *features* is not recommended.
+
+In general, this probably won't be very useful: read-time conditionals are
+often used to read symbols from packages which may not exist across
+implementations. And, of course, because this is a macro, it cannot appear
+in places where it won't be macroexpanded (e.g., the conditions of case).
+
+By the time you're in a position where this is actually useful,
+ #-(or a b c) (otherwise-clause)
+doesn't seem so bad. At least it'll look the same as your other feature
+conditionals!
+
+Note also that this does NOT provide a run-time check of *features*, but is
+instead a macroexpansion-time check."
+ (let* ((last-clause (car (last clauses)))
+ (otherwise-clause (when (member (car last-clause) '(t otherwise) :test #'eq)
+ last-clause)))
+ (when otherwise-clause (setf clauses (butlast clauses)))
+ `(progn
+ ,@(or (loop :for (cond . body) :in clauses
+ :when (featurep cond)
+ :return body)
+ (cdr otherwise-clause)))))
+
+(defmacro feature-econd (&body clauses)
+ "Like feature-cond, but automatically adds a final clause issuing a
+not-implemented error."
+ `(feature-cond ,@clauses (t (error 'not-implemented))))
+
+(defmacro feature-if (feature-expression true-form &optional else-form)
+ `(if (featurep ,feature-expression)
+ ,true-form
+ ,else-form))
+
+(defmacro feature-when (feature-expression &body body)
+ `(when (featurep ,feature-expression) ,@body))
+
+(defmacro feature-unless (feature-expression &body body)
+ `(unless (featurep ,feature-expression) ,@body))
+
+#+nil
+(feature-cond
+ (:clisp (do-clisp-thing-1)
+ (do-clisp-thing-2))
+ (:sbcl (do-sbcl-thing))
+ (t (error "not implemented")))
+
+#+nil
+(feature-cond
+ ((not :clisp) (do-clisp-thing-1)
+ (do-clisp-thing-2))
+ (:sbcl (do-sbcl-thing))
+ (t (error "not implemented")))
+
+#+nil
+(feature-cond
+ ((or :sbcl :clisp) (do-clisp-thing-1)
+ (do-clisp-thing-2))
+ (:clisp (do-sbcl-thing))
+ (t (error "not implemented")))
+
+#+nil
+(feature-cond
+ ((and (not :windows) :sbcl)
+ (do-sbcl-thing))
+ ((and (or :windows :win32) :clisp)
+ (do-clisp-thing-1)
+ (do-clisp-thing-2))
+ (t (error "not implemented")))
+
+#+nil
+(feature-econd
+ (:sbcl (do-sbcl-thing))
+ (:posix (do-posix-thing)))
\ No newline at end of file
diff -rN -u old-portaCL/feature-tests.lisp new-portaCL/feature-tests.lisp
--- old-portaCL/feature-tests.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/feature-tests.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,72 @@
+(in-package #:portaCL)
+
+(defvar *feature-tests* (make-hash-table :test #'eq))
+
+(define-condition undefined-feature-test (simple-error) ())
+
+(defun featurep (feature)
+ "Returns true if the feature is in *features*, or it is a feature
+expression which is true. Signals 'undefined-feature-test if the feature
+test is not recognized."
+ (let ((no-such-test (lambda (&rest _)
+ (declare (ignore _))
+ (restart-case
+ (error 'undefined-feature-test
+ :format-control "Unknown feature test: ~s"
+ :format-arguments (list (car feature)))
+ (treat-as-true ()
+ :report "Pretend this feature-form were true."
+ t)
+ (treat-as-nil ()
+ :report "Pretend this feature-form were false."
+ nil)))))
+ (if (consp feature)
+ (apply (gethash (car feature) *feature-tests* no-such-test)
+ (cdr feature))
+ (member feature *features* :test #'eq))))
+
+(defmacro define-feature-test (names lambda-list &body body)
+ "Defines a feature test. E.g., like the standard AND, OR, and NOT.
+
+The features provided /may/ be feature expressions, but it is left up to
+individual feature-test implementors to decide if such things make sense.
+In other words, feature-tests are FEXPRs, not macros or functions."
+ (when (stringp (first body)) (pop body))
+ (unless (listp names) (setf names (list names)))
+ (let ((lambda `(lambda ,lambda-list ,@body)))
+ `(eval-when (:load-toplevel :execute)
+ ,@(loop :for name :in names
+ :collect `(setf (gethash ',name *feature-tests*) ,lambda)))))
+
+
+
+(define-feature-test (and :and) (&rest rest)
+ "The standard AND feature test."
+ (every #'featurep rest))
+
+(define-feature-test (or :or) (&rest rest)
+ "The standard OR feature test."
+ (some #'featurep rest))
+
+(define-feature-test (not :not) (feature)
+ "The standard NOT feature test."
+ (not (featurep feature)))
+
+#||
+
+Examples:
+
+ (define-feature-test (never :never) ()
+ "What #+nil often gets used for."
+ nil)
+
+ (define-feature-test (fixme :fixme) (&rest references)
+ "Mark some code as to-be-fixed."
+ (declare (ignore references))
+ nil)
+
+ (define-feature-test (bug) (&rest bug-ids)
+ "Sometimes you can work around a bug if you know about it."
+ (some #'check-bug-applies bug-ids))
+
+||#
diff -rN -u old-portaCL/name-parts.lisp new-portaCL/name-parts.lisp
--- old-portaCL/name-parts.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/name-parts.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,24 @@
+(in-package #:portaCL)
+
+(defvar *implementation* nil)
+
+(defun lisp-implementation-names ()
+ "Returns a list of names likely to be used in the name of port files."
+ (feature-cond
+ (:allegro '("allegro"))
+ (:clisp '("clisp"))
+ (:cmu '("cmucl" "cmu"))
+ (:cormanlisp '("corman" "cormanlisp"))
+ (:ecl '("ecl"))
+ (:lispworks '("lispworks" "lw"))
+ (:mcl '("mcl"))
+ (:openmcl '("clozure" "openmcl" "mcl"))
+ (:sbcl '("sbcl"))
+ (:scl '("scl"))
+ (:abcl '("abcl" "armedbear"))
+ (t (restart-case (error 'not-implemented)
+ (use-value (value) value)))))
+
+(defun cl-user::implementation (stream object &optional colon-p at-p)
+ (declare (ignore object colon-p at-p))
+ (write-string *implementation* stream))
diff -rN -u old-portaCL/package.lisp new-portaCL/package.lisp
--- old-portaCL/package.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/package.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,24 @@
+(defpackage #:portaCL
+ (:use #:cl)
+ (:export ;; working with feature expressions
+ #:define-feature-test
+ #:featurep
+
+ ;; feature-expression-based control flow
+ #:feature-if
+ #:feature-when
+ #:feature-unless
+ #:feature-cond
+ #:feature-econd
+
+ ;; failure modes
+ #:not-implemented
+ #:not-supported
+ #:not-necessary
+
+ ;; ASDF support
+ #:port-file
+ #:port-module
+
+ ;; Enhanced feature reader support
+ #:install-feature-readers))
diff -rN -u old-portaCL/portacl.asd new-portaCL/portacl.asd
--- old-portaCL/portacl.asd 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/portacl.asd 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,16 @@
+
+(asdf:defsystem portaCL
+ :version "0.1.3"
+ :description "Eases the creation of portability libraries."
+ :maintainer " <pix@kepibu.org>"
+ :author " <pixel@kepibu.org>"
+ :licence "BSD-style"
+ :depends-on ()
+ :serial t
+ :components ((:file "package")
+ (:file "feature-tests")
+ (:file "conditions")
+ (:file "control-flow")
+ (:file "name-parts")
+ (:file "asdf-components")
+ (:file "reader")))
diff -rN -u old-portaCL/reader.lisp new-portaCL/reader.lisp
--- old-portaCL/reader.lisp 1970-01-01 00:00:00.000000000 +0000
+++ new-portaCL/reader.lisp 2013-07-06 20:50:59.000000000 +0000
@@ -0,0 +1,55 @@
+(in-package #:portaCL)
+
+(define-condition suppressed-error (warning)
+ ((original-error :initarg :error)
+ (feature-expression :initarg :feature))
+ (:report (lambda (c s)
+ (format s "Suppressed an error while testing feature expansion ~S: ~A"
+ (slot-value c 'feature-expression)
+ (slot-value c 'original-error)))))
+
+;; see CLHS 2.4.8.17 <http://www.lispworks.com/documentation/HyperSpec/Body/02_dhq.htm>
+(defun feature-reader (stream fn arg)
+ "Reader for enhanced #+/#- feature conditionals."
+ (when (and arg (not *read-suppress*))
+ (error 'simple-error
+ :format-control "Numeric arg (~D) specified on reader conditional where none allowed."
+ :format-arguments (list arg)))
+ (flet ((feature-truth (form)
+ ;; from CLHS *read-suppress* <http://www.lispworks.com/documentation/HyperSpec/Body/v_rd_sup.htm>:
+ ;; Any standardized reader macro that is defined to read a following
+ ;; object or token will do so, but not signal an error if the object
+ ;; read is not of an appropriate type or syntax.
+ ;;
+ ;; I take that to mean errors thrown during the course of #'featurep
+ ;; should be suppressed. Some implementations differ.
+ (handler-bind
+ ((error (lambda (c)
+ (when *read-suppress*
+ (warn 'suppressed-error :feature form :error c)
+ (return-from feature-truth nil)))))
+ (funcall fn form)))
+ (read-form (stream)
+ (read stream t nil t)))
+ (cond
+ ((feature-truth
+ (let ((*package* (find-package :keyword))
+ ;; Incorrectly interns symbols, but we need more than just cl:nil :/
+ (*read-suppress* nil))
+ (read-form stream)))
+ (values (read-form stream)))
+ (t
+ (let ((*read-suppress* t)) (read-form stream))
+ (values)))))
+
+(defun |#+-reader| (stream subchar arg)
+ (declare (ignore subchar))
+ (feature-reader stream #'featurep arg))
+
+(defun |#--reader| (stream subchar arg)
+ (declare (ignore subchar))
+ (feature-reader stream (complement #'featurep) arg))
+
+(defun install-feature-readers (&optional (*readtable* *readtable*))
+ (set-dispatch-macro-character #\# #\+ #'|#+-reader|)
+ (set-dispatch-macro-character #\# #\- #'|#--reader|))