combining two variables into one function name in macro - macros

I was toying around with macros and clos, where I created an "object" macro to create instances
(defmacro object (class &rest args)
`(make-instance ',class ,#args))
Now doing this, I also ended up kind of wanting to do something similar for accessor functions created by clos. Example:
(defclass person () ((name :accessor person-name :initarg :name)))
then creating the instance
(setf p1 (object person :name "tom"))
now to get the name from the object obviously I would call person-name, however just as with the object macro, I wanted to create a "gets" macro to do this. So ideally:
(gets person name p1) which then would return the name.
The problem then is the binding of person and name (person-name) and how to do that. Is there anyway to get those two arguments bound together in the macro? sort of like:
(defmacro gets (class var object)
`(,class-,var ,object))

I think I may have misunderstood the original intent. At first I thought you were asking how to generate the accessor names for the class definition, which third part of the answer addresses. After reading through a second time, it actually sounds like you want to generate a new symbol and call it with some argument. That's easy enough too, and is given in the second part of this answer. Both the second and third parts depend on being able to create a symbol with a name that's built from the names of other symbols, and that's what we start with.
"Concatenating" symbols
Each symbol has a name (a string) that you can obtain with symbol-name. You can use concatenate to create a new string from some old strings, and then use intern to get a symbol with the new name.
(intern (concatenate 'string
(symbol-name 'person)
"-"
(symbol-name 'name)))
;=> PERSON-NAME
Reconstructing an accessor name
(defmacro gets (class-name slot-name object)
(let ((accessor-name
(intern (concatenate 'string
(symbol-name class-name)
"-"
(symbol-name slot-name))
(symbol-package class-name))))
`(,accessor-name ,object)))
(macroexpand-1 '(gets person name some-person))
;=> (PERSON-NAME SOME-PERSON)
For a number of reasons, though, this isn't very robust. (i) You don't know whether or not the slot has an accessor of the form <class-name>-<slot-name>. (ii) Even if the slot does have an accessor of the form <class-name>-<slot-name>, you don't know what package it's in. In the code above, I made the reasonable assumption that it's the same as the package of the class name, but that's not at all required. You could have, for instance:
(defclass a:person ()
((b:name :accessor c:person-name)))
and then this approach wouldn't work at all. (iii) This doesn't work with inheritance very well. If you subclass person, say with north-american-person, then you can still call person-name with a north-american-person, but you can't call north-american-person-name with anything. (iv) This seems to be reïnventing slot-value. You can already access the value of a slot using the name of the slot alone with (slot-value object slot-name), and I don't see any reason that your gets macro shouldn't just expand to that. There you wouldn't have to worry about the particular name of the accessor (if it even has one), or the package of the class name, but just the actual name of the slot.
Generating accessor names
You just need to extract the names of the symbols and to generate a new symbol with the desired name.
If you want to automatically generate accessors with defstruct style names, you can do it like this:
(defmacro define-class (name direct-superclasses slots &rest options)
(flet ((%slot (slot)
(destructuring-bind (slot-name &rest options)
(if (listp slot) slot (list slot))
`(,slot-name ,#options :accessor ,(intern (concatenate 'string
(symbol-name name)
"-"
(symbol-name slot-name)))))))
`(defclass ,name ,direct-superclasses
,(mapcar #'%slot slots)
,#options)))
You can check that this produces the kind of code that you'd expect by looking at the macroexpansion:
(pprint (macroexpand-1 '(define-class person ()
((name :type string :initarg :name)
(age :type integer :initarg :age)
home))))
(DEFCLASS PERSON NIL
((NAME :TYPE STRING :INITARG :NAME :ACCESSOR PERSON-NAME)
(AGE :TYPE INTEGER :INITARG :AGE :ACCESSOR PERSON-AGE)
(HOME :ACCESSOR PERSON-HOME)))
And we can see that it works as expected:
(define-class person ()
((name :type string :initarg :name)
(age :type integer :initarg :age)
home))
(person-name (make-instance 'person :name "John"))
;=> "John"
Other comments on your code
(defmacro object (class &rest args)
`(make-instance ',class ,#args))
As Rainer pointed out this isn't very useful. For most cases, it's the same as
(defun object (class &rest args)
(apply 'make-instance class args))
except that you can (funcall #'object …) and (apply #'object …) with the function, but you can't with the macro.
Your gets macro isn't really any more useful than slot-value, which takes an object and the name of a slot. It doesn't require the name of the class, and it will work even if the class doesn't have a reader or accessor.
Don't (naïvely) create symbol names with format
I've been creating symbol names with concatenate and symbol-name. Sometimes you'll see people use format to construct the names, e.g., (format nil "~A-~A" 'person 'name), but that's prone to issues with capitalization settings that can be changed. For instance, in the following, we define a function foo-bar, and note that the format based approach fails, but the concatenate based approach works.
CL-USER> (defun foo-bar ()
(print 'hello))
FOO-BAR
CL-USER> (foo-bar)
HELLO
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (intern (concatenate 'string (symbol-name 'foo) "-" (symbol-name 'bar))))
Hello
Hello
CL-USER> (format nil "~a-~a" 'foo 'bar)
"Foo-Bar"
CL-USER> (intern (format nil "~a-~a" 'foo 'bar))
|Foo-Bar|
Nil
CL-USER> (funcall (intern (format nil "~a-~a" 'foo 'bar)))
; Evaluation aborted on #<Undefined-Function Foo-Bar {1002BF8AF1}>.
The issue here is that we're not preserving the case of the symbol names of the arguments. To preserve the case, we need to explicitly extract the symbol names, rather than letting the print functions map the symbol name to some other string. To illustrate the problem, consider:
CL-USER> (setf (readtable-case *readtable*) :preserve)
PRESERVE
;; The symbol-names of foo and bar are "foo" and "bar", but
;; you're upcasing them, so you end up with the name "FOO-BAR".
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'STRING-UPCASE '(foo bar)))
"FOO-BAR"
;; If you just concatenate their symbol-names, though, you
;; end up with "foo-bar".
CL-USER> (CONCATENATE 'STRING (SYMBOL-NAME 'foo) "-" (SYMBOL-NAME 'bar))
"foo-bar"
;; You can map symbol-name instead of string-upcase, though, and
;; then you'll get the desired result, "foo-bar"
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'SYMBOL-NAME '(foo bar)))
"foo-bar"

This function creates symbols from string designators:
(defun symb (&rest args)
(intern (format nil "~{~a~^-~}" (mapcar #'string args))))
The function uses format, yet passes Joshua's test:
CL-USER> (symb 'foo :bar "BAZ")
FOO-BAR-BAZ
NIL
CL-USER> (defun foo-bar ()
(print 'hello))
FOO-BAR
CL-USER> (foo-bar)
HELLO
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (symb 'foo 'bar))
Hello
Hello

If you want your gets to use accessor methods:
(defmacro gets (class var object)
`(,(intern (format nil "~a-~a" (symbol-name class) (symbol-name var))) ,object))
In general, what you're trying to accomplish is not really useful. make-instance is a well known symbol, easily greppable, part of the standard and optimized by some implementations when the class name is constant. So with your object macro, you're just saving a few characters and a single-quote. Usually, one hides make-instance in specific cases where you don't want to provide a direct way to initialize instances, or more likely, when you want to provide layers of initialization (e.g. phases of initialization, Lisp slots and foreign objects).
PS: I remember vaguely that someone prominent in the standardization of Common Lisp argued in favor of always wrapping/hiding make-instance in a function (e.g. make-<class-name>), but I can't find either a reference or the reasoning.
PPS: Here's a rather old discussion (2004) about it in comp.lang.lisp (and another one from 2002). The main reasons people cite in favor of constructor functions are:
Required arguments; achievable at runtime instead of at compile-time with :initform (error ...) in a slot that requires a provided initial value
Generally, hide implementation details: class instance, structure instance, cons, something else
2.1. Not wanting to export the actual class name
2.2. Being able to return an instance of some other class, usually a subclass
Convenient shorthand for a specific class
I striked always, because it seems proponents to constructor functions for CLOS objects don't necessarily want to hide the protocol that make-instance follows (allocate-instance, initialize-instance → shared-initialize) to implementers or extenders of the API or framework, although they might want to hide it to the consumers of the API or framework.
For something faster, you might want to access slots directly, but that doesn't use accessor methods, and hence doesn't support side-effects, e.g. :before and :after methods:
(defmacro gets (class var object)
(let ((object-var (gensym)))
`(let ((,object-var ,object))
(declare (optimize (speed 3) (safety 0) (debug 0))
(type ,class ,object-var))
(slot-value ,object-var ',var))))
This might be a direct slot access on some implementations.
Finally, you also have with-slots and with-accessors in the standard.

Try playing with something like this:
(let ((a 'a)
(dash '-)
(b 'b))
`(,a,dash,b))
The other possibilities is to use intern, or more user friendly, alexandria's symbolicate.

Related

Different initialization, Common Lisp

Can I mimic different constructors in CL?
To elaborate -- in, say, C++, I can make different constructors for the same class depending on what arguments are passed.
Can I do this with CLOS? Probably having different initialize-instances key args or something like that?
One approach to doing this is to have a secondary initialization method:
(defclass myclass ()
((s1 :initarg :s1 :accessor s1)))
(defgeneric initialize-myclass (dispatch class &key))
(defmethod initialize-instance :after ((c myclass) &rest args &key (dispatch 'normal)
&allow-other-keys)
(apply #'initialize-myclass dispatch c args))
(defmethod initialize-myclass ((dispatch (eql 'normal)) (class myclass) &key))
(defmethod initialize-myclass ((dispatch (eql 'special)) (class myclass)
&key x &allow-other-keys)
(print x))
Now you can say
(make-instance 'myclass :dispatch 'special ...)
For instance. Note this is not necessarily a good way of doing it, but it does work, and I've used it. Note also I may have got the keyword-argument defaulting wrong: I never remember where you need to say &allow-other-keys & where you don't, and where the right place to say it is.
The basic problem here is that we want an additional thing to dispatch on: initialize-instance can dispatch on the class of the object being defined, but that's all it can dispatch on. In particular it can't dispatch on one of its keyword arguments because you can't do that in CLOS. But we can take one of its keyword arguments (dispatch here) and 'bless' it as a positional argument to a secondary initialization generic function, which then can dispatch on that argument.
Well, initialize-instance is typically defined as an :after method to run some sort of post-processing once the instance has been initialized through make-instance. What you might do is use parametric polymorphism (dispatching on parameters) and have different methods initialize your instance based on the parameters supplied. Consider the following example:
CL-USER> (defclass my-class ()
((a :initarg :a
:accessor my-class-a)))
#<STANDARD-CLASS COMMON-LISP-USER::MY-CLASS>
CL-USER> (defmethod make-my-class ((a number))
(make-instance 'my-class :a (format nil "Look ma, a number ~a" a)))
#<STANDARD-METHOD COMMON-LISP-USER::MAKE-MY-CLASS (NUMBER) {1016445273}>
CL-USER> (defmethod make-my-class ((a string))
(make-instance 'my-class :a (format nil "Look ma, a string ~a" a)))
#<STANDARD-METHOD COMMON-LISP-USER::MAKE-MY-CLASS (STRING) {10166065C3}>
CL-USER> (make-my-class 10)
#<MY-CLASS {1016690E33}>
CL-USER> (my-class-a *)
"Look ma, a number 10"
CL-USER> (make-my-class "foo")
#<MY-CLASS {1016694CD3}>
CL-USER> (my-class-a *)
"Look ma, a string foo"
As you can see, the method make-my-class dispatches on its argument and initializes my-class accordingly.

Advanced symbol-macrolet

Suppose I have a class class with slots first and second. Inside my function I can bind a variable to one of those slots like
(symbol-macrolet ((var (first cls)))
....)
Obviously I can also bind the second slot to smth.
Questions is, let's say that first and second are either some number or nil. Let's also say that if second is non-nil, first is always nil. Now, can I bind my var to a non-nil one with just one macro? So it just looks at instance of the class given and then check if second is nil. If no, it binds var to second, otherwise to first.
Seems complicated, but I'm pretty sure it can be done, just don't know where to start.
To further generalize -- is it possible to bond a variable not to a single place, but to one of a specific set, depending on some state?
I think this is not quite simple. You could do something like this which works for reading only (I've used a fake toy structure so my code works, which is given here):
(defstruct toy
(first nil)
(second nil))
(defun foo (a-toy)
(symbol-macrolet ((x (or (toy-first a-toy) (toy-second a-toy))))
...))
But now (setf x ...) is horribly illegal. You can get around this, once you've decided what (setf x ...) should do, by defining some local functions. I've decided here that it should set the non-nil slot, as that makes sense to me.
(defun bar (a-toy)
(flet ((toy-slot (the-toy)
(or (toy-first the-toy) (toy-second the-toy)))
((setf toy-slot) (new the-toy)
(if (toy-first the-toy)
(setf (toy-first the-toy) new)
(setf (toy-second the-toy) new))))
(symbol-macrolet ((x (toy-slot a-toy)))
(setf x 2)
a-toy)))
And now you can wrap this all in a single macro:
(defmacro binding-toy-slot ((x toy) &body forms)
(let ((tsn (make-symbol "TOY-SLOT")))
`(flet ((,tsn (the-toy)
(or (toy-first the-toy) (toy-second the-toy)))
((setf ,tsn) (new the-toy)
(if (toy-first the-toy)
(setf (toy-first the-toy) new)
(setf (toy-second the-toy) new))))
(symbol-macrolet ((,x (,tsn ,toy)))
,#forms))))
(defun bar (a-toy)
(binding-toy-slot (x a-toy)
(setf x 3)
a-toy))
Obviously you might want to generalise binding-toy-slot, so it, for instance, takes a list of slot accessor names or something like that.
There may also be better ways of doing this I haven't thought of: there might be clever tricks with setf-expansions that let you do it without the little helper functions. You could also have global helper functions which get passed an object and a list of accessors to try which would make the code slightly smaller (although you can probably achieve similarly small code in any serious implementation by declaring the helpers inline which should cause them to be completely compiled away).
An alternative, and perhaps better, approach, is to define the protocol you want to achieve using generic functions. This means things are defined globally, and it's related to but not quite the same as Kaz's answer.
So again, let's say I have some class (this can be a structure, but making it a fully-fledged standard-class lets us have unbound slots, which is nice):
(defclass toy ()
((first :initarg :first)
(second :initarg :second)))
Now you could either define generic functions with names like appropriate-slot-value & (setf appropriate-slot-value), or you could define GF which returns the name of the appropriate slot, like so:
(define-condition no-appropriate-slot (unbound-slot)
;; this is not the right place in the condition heirarchy probably
()
(:report "no appropriate slot was bound"))
(defgeneric appropriate-slot-name (object &key for)
(:method :around (object &key (for ':read))
(call-next-method object :for for)))
(defmethod appropriate-slot-name ((object toy) &key for)
(let ((found (find-if (lambda (slot)
(slot-boundp object slot))
'(first second))))
(ecase for
((:read)
(unless found
(error 'no-appropriate-slot :name '(first second) :instance object))
found)
((:write)
(or found 'first)))))
And now the accessor function pair can be plain functions which will work for any class where there is a method for appropriate-slot-name:
(defun appropriate-slot-value (object)
(slot-value object (appropriate-slot-name object :for ':read)))
(defun (setf appropriate-slot-value) (new object)
;; set the bound slot, or the first slot
(setf (slot-value object (appropriate-slot-name object :for ':write)) new))
Finally, we can now have functions which just use symbol-macrolet in the obvious way:
(defun foo (something)
(symbol-macrolet ((s (appropriate-slot-value something)))
... s ... (setf s ...) ...))
So, that's another approach.
Simple, inefficient way with defsetf:
(defun second-or-first (list)
(or (second list) (first list)))
(defun set-second-or-first (list val)
(if (second list)
(setf (second list) val)
(setf (first list) val)))
(defsetf second-or-first set-second-or-first)
(defun test ()
(let ((list (list nil nil)))
(symbol-macrolet ((sof (second-or-first list)))
(flet ((prn ()
(prin1 list) (terpri)
(prin1 sof) (terpri)))
(prn)
(setf sof 0)
(prn)
(setf sof 1)
(prn)
(setf (second list) 3)
(prn)
(setf sof nil)
(prn)
(setf sof nil)
(prn)))))
If it is okay that update expressions like (incf sof) wastefully traverse the structure twice, this is adequate.
Otherwise a more sophisticated implementation is required using define-setf-expander. The gist of such a solution is that the generated code has to calculate which of the two cons cells of the list holds the current place, storing that cons cell in a temporary variable #:temp. Then the place we are interested in is denoted by (car #:temp). If #:temp is the second cell, avoiding two accesses to are tricky (one access to determine it's the one we want, then the other to get the prior value). Basically what we can do is have another temp variable which holds the value of the place that we obtained as a side effect of checking whether it is not nil. Then designate that temporary variable as the access form for getting the prior value.
Here’s how you might not use symbol macros without any huge loss:
(defgeneric firsty-secondy (thing))
(defgeneric (setf firsty-secondy) (newval thing))
(defmethod firsty-secondy ((x my-class))
(or (secondy x) (firsty x)))
(defmethod (setf firsty-secondy) (nv (x my-class))
(if (secondy x)
(setf (secondy x) nv)
(setf (firsty x) nv)))
You may find that the compiler does better with these because within the methods it can be more sure about where the slots for the fields are in memory.
Here is a way to structure your object to not need to do this and enforce your invariant a bit better:
(defclass my-class
((is-first :initform nil)
(thingy :initform nil)))
Here is a comparison:
first=nil,second=nil : is-first=nil,thingy=nil
first=123,second=nil : is-first=t ,thingy=123
first=nil,second=123 : is-first=nil,thingy=123
first=123,second=456 : unrepresentable

Symbol manipulation in lisp macro

I'm writing a toy interpreter for a Lisp language, in which I have the following CL code:
(defun mal-list (&rest args)
(make-mal :type 'list
:value args))
(register-fun '|list| #'mal-list)
(defun mal-list? (arg)
(eq (mal-type arg) 'list))
(register-fun '|list?| #'mal-list?)
However, I'd rather simply write something like this:
(defmal list (&rest args)
(make-mal :type 'list
:value args))
(defmal list? (arg)
(eq (mal-type arg) 'list))
I tried to write a macro to do this, but I had problems with the symbols with the bars (I'm pretty confused as to what this is!). This is what I tried:
(defmacro defmal (name args &body body )
(let ((funsym (intern (format nil "~{~a~}" `(mal- ,name)))))
`(register-fun `|,name| (defun ,funsym ,args ,#body))))
which didn't work out, because `|,name| literaly meant |,name|, and not |list|
I'm guessing this is an XY problem, but I'm not sure how to approach this otherwise.
The |...| syntax is just one of the ways that the Lisp printer can print symbols that have characters in their name that need to be escaped (and that the reader can read symbols with those kinds of characters in their names):
(print (intern "foo"))
;=> |foo|
There are other ways, too, including escaping individual characters:
(print '|FOO|)
;=> FOO
(print '\f\o\o)
;=> |foo|
What you're trying to do is simply create a symbol whose name includes lower case letters. That's easy enough, as shown above. Part of your issue, though, is that you're getting as input a symbol whose name is full of capital letters, so you'll need to downcase first:
CL-USER> (symbol-name 'FOO)
;=> "FOO"
CL-USER> (intern (symbol-name 'FOO))
;=> FOO
CL-USER> (string-downcase (symbol-name 'FOO))
;=> "foo"
CL-USER> (intern (string-downcase (symbol-name 'FOO)))
;=> |foo|
In fact, because string-downcase takes string designators, not just strings, you can pass the symbol in directly:
CL-USER> (intern (string-downcase 'BaR))
;=> |bar|
So, after all that string processing, we can move to the macro.
It sounds like you're looking for something like this:
(defmacro defmal (name lambda-list &body body)
(let ((mal-name (intern (concatenate 'string "MAL-" (symbol-name name))))
(mal-norm (intern (string-downcase name))))
`(progn
(defun ,mal-name ,lambda-list
,#body)
(register-function ',mal-norm #',mal-name))))
CL-USER> (pprint (macroexpand-1 '(defmal list? (arg)
(eq (mal-type arg) 'list))))
(PROGN
(DEFUN MAL-LIST? (ARG) (EQ (MAL-TYPE ARG) 'LIST))
(REGISTER-FUNCTION '|list?| #'MAL-LIST?))
It's generally a good idea to avoid using format in generating symbol names, because the specific output can change, depending on other variables. E.g.:
(loop for case in '(:upcase :downcase :capitalize)
collect (let ((*print-case* case))
(format nil "~a" 'foo)))
;=> ("FOO" "foo" "Foo")
Instead, you can use concatenate with a string (or the symbol name of a symbol). Because the reader can also have different settings for case sensitivity, sometimes I'll even do (but not everyone likes this):
(concatenate 'string (symbol-name '#:mal-) (symbol-name name))
This way, if the reader does anything unusual (e.g., preserves case, so that the symbol name of mal- is "mal-), you can preserve it in your own generated symbol, too.
In addition to Joshua's detailed answer, consider using a function from the Alexandria library:
format-symbol is like format, but inside with-standard-io-syntax. Here, t stands for the current package and name is downcased:
(format-symbol t "mal-~(~A~)" name)
=> |mal-list|
symbolicate concatenates and interns in current package:
(symbolicate '#:mal- name)
You can end-up with either |MAL-LIST| or |mal-list| if your current readtable preserves case or not. For completeness, note that readtable-case can be set to the following values: :upcase, :downcase, :preserve or :invert (this one I find quite interesting).

How to call a macro with a parameter instead of list in LISP?

Based on the example provide in the practical common lisp reference, I define a macro to create a class as followed.
(defmacro define-class (class-name class-slot)
`(defclass ,class-name ()
,(mapcar #'slot->defclass-slot class-slot))))
The function slot->declass-slot take a single argument and generate a standard line describing a slot in a class. The code is the following:
(defun slot->defclass-slot (spec)
`(,spec :initarg ,(as-keyword spec) :accessor ,spec :initform 0))
For example,
(slot->defclass-slot 'nom)
(NOM :INITARG :NOM :ACCESSOR NOM :INITFORM 0)
All this work fine, when I create a class 'model' as follow:
(define-class model (nom id))
But suppose that I define a parameter instead.
(defparameter *test* '(nom id))
(define-class model *test*)
Then, the code end-up in an error:
The value *TEST* is not of type LIST.
What is wrong?
Your define-class macro does not evaluate its class-slots argument.
You can "fix" your code like this:
(defmacro define-class (class-name class-slots)
`(eval
`(defclass ,',class-name ()
,#(mapcar #'slot->defclass-slot ,class-slots))))
(macroexpand-1 '(define-class model '(nom id)))
(defparameter *test* '(nom id))
(define-class model *test*)
Note that you now have to quote the literal second argument to define-class.
Note also that you are now using eval (for a good reason, in this case).
Note finally that I seriously doubt that you truly want to do this. Chances are you don't need this level of dynamism, and you are just complicating your life for no good reason.
E.g., if you just want to get the list of class slots (using your *test* variable), you should use MOP instead.
In fact you can make your macro expand to the function ensure-class:
> (mop:ensure-class 'foo :direct-slots '((:name a)))
#<STANDARD-CLASS FOO>
but this relies on a somewhat brazen assumption that your implementation is MOP-compliant.
(defparameter *test* '(nom id))
(define-class model *test*)
You shouldn't try to do this, for the same reason that you never try to do:
(with-open-file '(...)
...)
The point of the macro is to not evaluate the arguments in order that you can do something with them. What you can do instead, if you do for some reason, need both a macro- version and non-macro- version, is to define the macro functionality in terms of a function, and then wrap the function in a macro when you need a macro. E.g., (for a not-particularly robust) with-open-file):
(defun %with-open-file (filename function &rest args)
(let ((file (apply 'open filename args)))
(prog1 (funcall function file)
(close file))))
(defmacro with-open-file ((var filename &rest args) &body body)
`(%with-open-file ,filename
(lambda (,var) ,#body)
,#args))
Then you can use the macro-version when you want it, and the function-version when you want it. In your case, though, that's not a perfect solution, since you're expanding to another macro call.

define variable with defparameter with name determined at runtime

I would like to initiate dynamically a hash table with defmethod or defun using one of the arguments to create the name. For instance:
(defun foo (arg)
(let ((NAME (read-from-string (format nil "\*~S\*" arg))))
(defparameter NAME (make-hash-table))))
Of course, foo create hash table with the symbol NAME, instead of the value of NAME in let. What can I do to get the value of NAME to create this hash table?
General Remarks
It is almost always wrong to create global variables in functions.
It is also almost always wrong to create new symbols using read-from-string instead of intern.
Use a Macro
What you probably want is
(defmacro def-ht (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
`(defparameter ,var (make-hash-table))))
(def-ht foo)
Use a Function
You might be able to do it in a function too - by inspecting the macroexpansion of a defparameter form and placing the needed stuff in the function:
(defun make-ht-var (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
(setf (symbol-value var) (make-hash-table))
(proclaim (list var 'special))))
(make-ht-var 'foo)
Note that the argument to the function is quoted, but the argument to the macro is not.
You need to use a macro instead of a function. DEFPARAMETER will bind value of MAKE-HASH-TABLE to the symbol NAME because it evaluates at macro-expansion time which occurs earlier than run-time, which is when the function FOO binds the lexical value of NAME.
Look up the CL evaluation model for a deeper understanding.
(defmacro foo (arg)
(let ((name (read-from-string (format nil "*~S*" arg))))
`(defparameter ,name (make-hash-table))))
(foo "my-hash")
=> <hash-table 0x121>
*my-hash*
=> <hash-table 0x121>