Commit c9f6aa81 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Define parameters as symbols made functional, check for redefinitions

parent 63025912
;; Standard metadata to attach to variables.
;; Liam Healy 2013-02-16 20:51:14HST variable-metadata.lisp
;; Time-stamp: <2013-04-07 19:31:01EDT variable-metadata.lisp>
;; Time-stamp: <2013-04-20 13:19:45EDT variable-metadata.lisp>
;; Copyright 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -43,8 +43,8 @@
(defvar *parameters* nil "Parameters.")
(defvar *symbols* (make-hash-table) "Parameter symbols.")
;;; define an add-to-symbol-table
(defvar *symbols* (make-hash-table)
"Table of synonyms and corresponding canonical parameter names.")
(defun ensure-package (package)
"If the non-nil package designator designates an existing package, return it. If it designates a non-existent package, make and return it. Otherwise, return the current package."
......@@ -52,10 +52,36 @@
(or (when package (or (find-package package) (make-package package)))
(defun add-to-symbol-table (list canonical-symbol)
"Add the list of symbols to the hash table."
;; warn if redefining?
(mapcar (lambda (symb) (setf (gethash symb *symbols*) canonical-symbol)) list))
(defmacro canonical-parameter-name (symbol)
`(gethash ,symbol *symbols*))
(defun add-symbol-to-table (symbol synonym &optional (redefine-action :warning))
"Add the synonym to the hash table."
;; Subtle problem: if there is a synonym for some parameter and then the canonical name is used as a synonym for a new parameter, using the original synonym will cause a malfunction.
(when (and
(canonical-parameter-name synonym)
(not (eql (canonical-parameter-name synonym) symbol)))
(case redefine-action
(:warning (warn "Symbol ~a is already defined as ~a; redefining"
(canonical-parameter-name synonym)))
(:error (cerror
"Redefine the symbol"
"Symbol ~a is already defined as ~a"
(canonical-parameter-name symbol)))))
(setf (canonical-parameter-name synonym) symbol))
(defun add-symbols-to-table (symbol synonyms)
"Add the synonyms to the hash table."
(mapcar (alexandria:curry 'add-symbol-to-table symbol) synonyms))
(defun check-parameter-type (value type error)
(unless (funcall *parameter-check-function* value type)
(if error
(error "Parameter value ~a is not the required type or dimension ~a"
value type))))
(defmacro define-parameter
(category name
......@@ -64,16 +90,17 @@
(let* ((package (ensure-package category))
(symbol (let ((*package* package)) (alexandria:symbolicate name)))
(syns (let ((*package* package)) (mapcar 'alexandria:symbolicate synonyms))))
(check-parameter-type value type t symbol 'delete-this) ; will need to be rewritten to not take symbol
(when type-supplied-p (check-parameter-type value type t))
(defparameter ,symbol ,value ,description)
(export ,symbol ,(package-name package))
(export ',symbol ,(package-name package))
,@(when type-supplied-p `((setf (get ',symbol :type) ',type)))
,@(when attribute-supplied-p `((setf (get ',symbol :attribute) ',attribute)))
(pushnew ',symbol *parameters*)
(add-to-symbol-table ,(cons symbol syns) ,symbol))))
(add-symbols-to-table ',symbol ',(cons symbol syns)))))
;;; Test definition
(define-parameter nf :style :value 20
:type (or null fixnum (member :tex :short :readable))
:synonyms (:foo)
:description "Style of format, plain (nil), LaTeX (:tex), or plain but")
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment