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

Parameters: continue port to special variables

parent 83e76be6
;; Standard metadata to attach to variables.
;; Liam Healy 2013-02-16 20:51:14HST variable-metadata.lisp
;; Time-stamp: <2013-05-20 22:50:07EDT variable-metadata.lisp>
;; Time-stamp: <2013-05-22 22:38:25EDT variable-metadata.lisp>
;; Copyright 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -41,7 +41,7 @@
(defvar *categories* nil "Categories of parameters, which correspond to packages.")
(defvar *parameters* nil "Parameters.")
(defvar *parameters* nil "A list of the parameters (canonical names only) as symbols.")
(defvar *symbols* (make-hash-table)
"Table of synonyms and corresponding canonical parameter names.")
......@@ -77,43 +77,53 @@
"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))))
(defun export-parameter-symbol (category name)
(export ',symbol ,(package-name (symbol-package symbol))))
(defun find-parameter-symbol (category name)
(canonical-parameter-name (find-symbol (string name) (ensure-package category))))
(defun find-parameter-symbol-exporting (category name)
(let ((symbol (find-parameter-symbol category name)))
(export symbol (package-name (symbol-package symbol)))
symbol))
(let ((*package* (ensure-package category))) (alexandria:symbolicate name)))
(defmacro define-parameter
(category name
&key value (type nil type-supplied-p) (attribute nil attribute-supplied-p) description synonyms)
&key (value nil value-supplied-p) (type nil type-supplied-p) (attribute nil attribute-supplied-p) description synonyms)
"Define the parameter (global special variable) with the given name. It will be defined in the package named by category (which will be created if necessary), and exported from it."
(let* ((symbol (find-parameter-symbol-exporting category name))
(syns (mapcar (alexandria:curry 'find-parameter-symbol-exporting category) synonyms)))
(when type-supplied-p (check-parameter-type value type t))
(let* ((symbol (find-parameter-symbol category name))
(syns (mapcar (alexandria:curry 'find-parameter-symbol category) synonyms)))
`(progn
(defparameter ,symbol ,value ,description)
(ensure-package ,category)
(pushnew (find-package ,category) *categories*)
(export ',(cons symbol syns) ,(package-name (symbol-package symbol)))
(defparameter ,symbol nil ,description)
,@(when type-supplied-p `((setf (get ',symbol :type) ',type)))
,@(when value-supplied-p `((set-parameter-value* ,symbol ,value)))
,@(when attribute-supplied-p `((setf (get ',symbol :attribute) ',attribute)))
(pushnew ',symbol *parameters*)
(add-symbols-to-table ',symbol ',(cons symbol syns)))))
;;; Test definition
(define-parameter nf :style :value 20
(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")
(defmacro parameter-value (category name)
"Get or set the parameter value."
`(symbol-value ',(find-parameter-symbol category name)))
`(symbol-value ',(canonical-parameter-name (find-parameter-symbol category name))))
(defparameter *parameter-check-function* 'typep)
(defun check-parameter-type (symbol value error)
(unless (funcall *parameter-check-function* value (get symbol :type))
(when error
(error "Parameter ~a value ~a is not the required type ~a"
symbol value (get symbol :type)))))
(defmacro set-parameter-value* (symbol value)
"Set the parameter value, checking that the value is of the correct type."
(alexandria:once-only (value)
`(progn (check-parameter-type ',symbol ,value t)
(setf ,symbol ,value))))
(defmacro set-parameter-value (category name value)
"Set the parameter value, checking that the name is legitimate and the value is of the correct type."
(set-parameter-value* (canonical-parameter-name (find-parameter-symbol category name)) value))
;; (parameter-value :nf :foo)
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