Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!swrinde!zaphod.mps.ohio-state.edu!usc!aero-c!srt
From: srt@aero.org (Scott "TCB" Turner)
Newsgroups: comp.lang.lisp
Subject: Re: Question about INTERN
Message-ID: <1991Feb12.184355.11142@aero.org>
Date: 12 Feb 91 18:43:55 GMT
References: <ALMS.91Jan31114032@ministry.cambridge.apple.com> <1991Jan31.174839.20943@Think.COM> <4093@skye.ed.ac.uk>
Sender: news@aero.org
Organization: The Aerospace Corporation, El Segundo, CA
Lines: 46

In article <4093@skye.ed.ac.uk> jeff@aiai.UUCP (Jeff Dalton) writes:
>(defun concat-symbol (&rest parts)
>  (intern (apply #'concatenate 'string (mapcar #'string parts))))

If you are going to do this frequently - as in a system where you
generate numerous identifiers by concatenating a number to a prefix,
i.e., "gen.12" - you should implement this using a general vector 
and fill-pointers.  Eliminating all the temporary strings can be 
a big savings in terms of time and garbage.  

Here's an example function that generates prefix+id symbols.  In AKCL,
this function generates no garbage at all.  Exactly how this function
works I leave as an exercise to the reader.  :-)

;;;
;;;  Make-Inst-Id
;;;
;;;  Take a prefix ("gen"), the length of the prefix (3), and an id
;;;  number to append (12) and return the appropriate symbol (gen.12).
;;;  Note that prefix is a variable-length character array, is
;;;  modified by this function, and must be long enough for
;;;  construction of the symbol's print name.  This function assumes
;;;  prefix is length 50 - to generalize, use array-dimension.
;;;
(proclaim '(function make-inst-id (vector fixnum fixnum) symbol))
(defun make-inst-id (prefix prefix-len num)
  (declare (fixnum prefix-len) (fixnum num))
  (setf (fill-pointer prefix) 49)
  (do* ((n num (the fixnum (do ((n1 n (the fixnum (- n1 10)))
				(i 0 (1+ i)))
			       ((< n1 10) i)
			       (declare (fixnum n1) (fixnum i)))))
	(start (the fixnum (do ((n1 10 (the fixnum (* n1 10)))
				(i 1 (1+ i)))
			       ((> n1 num)
				(the fixnum (+ i prefix-len)))
			       (declare (fixnum n1) (fixnum i)))))
        (j (1- start) (1- j)))
       ((< j prefix-len)
	(setf (fill-pointer prefix) start)
	(intern prefix))

       (declare (fixnum n) (fixnum start) (fixnum j))

       (setf (char prefix j)
	     (code-char (the fixnum (+ 48 (the fixnum (mod n 10))))))))