Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Sébastien Villemot
antik
Commits
87ac601d
Commit
87ac601d
authored
May 22, 2013
by
Liam M. Healy
Browse files
Parameters: continue port to special variables
parent
83e76be6
Changes
1
Hide whitespace changes
Inline
Side-by-side
input-output/variable-metadata.lisp
View file @
87ac601d
;; Standard metadata to attach to variables.
;; Liam Healy 2013-02-16 20:51:14HST variable-metadata.lisp
;; Time-stamp: <2013-05-2
0
22:
50:07
EDT variable-metadata.lisp>
;; Time-stamp: <2013-05-2
2
22:
38:25
EDT 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
"
Parameter
s."
)
(
defvar
*parameters*
nil
"
A list of the parameters (canonical names only) as symbol
s."
)
(
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)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment