Google
 

Trailing-Edge - PDP-10 Archives - clisp - clisp/upsala/feature.clisp
There are no other files named feature.clisp in the archive.
;;; -*-Mode:CLISP; Package:LISP-*-
;;; Make features nicer?
;;; With these fixes to featurep & make-feature, we have all features in the
;;; keyword package, to make them easily accessible from all packages.

(in-package 'lisp)
(export '(make-feature))

(defun featurep (x)
  "If X is an atom, see if it is present in *FEATURES*.  Also
  handle arbitrary combinations of atoms using NOT, AND, OR."
  (let ((x (if (atom x) (intern (symbol-name x) *keyword-package*)
	     x)))
    (cond ((atom x) (memq x *features*))
	  ((eq (car x) 'not) (not (featurep (cadr x))))
	  ((eq (car x) 'and)
	   (every #'featurep (cdr x)))
	  ((eq (car x) 'or)
	   (some #'featurep (cdr x)))
	  (t nil))))

(defun make-feature (x)
  "Make X be a feature, i.e. push it on *FEATURES*"
  (let ((x (if (atom x) (intern (symbol-name x) *keyword-package*)
	     x)))
    (when (not (featurep x))
      (push x *features*))))

(eval-when (eval load)
  (mapl #'(lambda (x)			; Make all features keywords
	    (rplaca x (intern (symbol-name (car x))
			      *keyword-package*)))
	*features*)
)