Skip to content
Snippets Groups Projects
Commit c8d88e5d authored by pmai's avatar pmai
Browse files

Added bootstrap file to make compilation of current CVS with a lisp

without the extended function name functionality work.
parent 3453e397
No related branches found
No related tags found
No related merge requests found
(in-package "EXTENSIONS")
(export '(define-function-name-syntax valid-function-name-p))
(in-package "LISP")
;;;; Function names.
(defvar *valid-function-names* ())
(defun %define-function-name-syntax (name syntax-checker)
(let ((found (assoc name *valid-function-names* :test #'eq)))
(if found
(setf (cdr found) syntax-checker)
(setq *valid-function-names*
(acons name syntax-checker *valid-function-names*)))))
(defmacro define-function-name-syntax (name (var) &body body)
"Define (NAME ...) to be a valid function name whose syntax is checked
by BODY. In BODY, VAR is bound to an actual function name of the
form (NAME ...) to check. BODY should return two values.
First value true means the function name is valid. Second value
is the name, a symbol, of the function for use in the BLOCK of DEFUNs
and in similar situations."
(let ((syntax-checker (symbolicate '%check- name '-function-name)))
`(progn
(defun ,syntax-checker (,var) ,@body)
(%define-function-name-syntax ',name #',syntax-checker))))
(defun valid-function-name-p (name)
"First value is true if NAME has valid function name syntax.
Second value is the name, a symbol, to use as a block name in DEFUNs
and in similar situations."
(typecase name
(cons
(when (and (symbolp (car name))
(consp (cdr name)))
(let ((syntax-checker (cdr (assoc (car name) *valid-function-names*
:test #'eq))))
(when syntax-checker
(funcall syntax-checker name)))))
(symbol (values t name))
(otherwise nil)))
(define-function-name-syntax setf (name)
(destructuring-bind (setf fn &rest rest) name
(declare (ignore setf))
(when (null rest)
(typecase fn
(symbol
(values t fn))
(cons
(unless (eq 'setf (car fn))
(valid-function-name-p fn)))))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment