;;;
;;; misc utilities too small for their own files.
;;;

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "ESB-UTILS")


;;; Symbolicate

(defun symbolicate (&rest things)
  (let* ((length (reduce #'+ things
			 :key (lambda (x) (length (string x)))))
	 (name (make-array length :element-type 'character)))
    (let ((index 0))
      (dolist (thing things (values (intern name)))
	(let* ((x (string thing))
	       (len (length x)))
	  (replace name x :start1 index)
	  (incf index len))))))


;;; Once-only

;;;; "The macro ONCE-ONLY has been around for a long time on various
;;;; systems [..] if you can understand how to write and when to use
;;;; ONCE-ONLY, then you truly understand macro." -- Peter Norvig,
;;;; _Paradigms of Artificial Intelligence Programming: Case Studies
;;;; in Common Lisp_, p. 853

;;; ONCE-ONLY is a utility useful in writing source transforms and
;;; macros. It provides a concise way to wrap a LET around some code
;;; to ensure that some forms are only evaluated once.
;;;
;;; Create a LET* which evaluates each value expression, binding a
;;; temporary variable to the result, and wrapping the LET* around the
;;; result of the evaluation of BODY. Within the body, each VAR is
;;; bound to the corresponding temporary variable.
;;;
;;; This macro has been rewritten to eliminate the FIXME and not use
;;; NAMED-LET, which is an abomination.
(defmacro once-only (specs &body body)
  (if (null specs)
      `(progn ,@body)
      (destructuring-bind
	    (name value-expression)
	  (first specs)
	(let ((temp (gensym (symbol-name name))))
	  `(let ((,temp ,value-expression)
		 (,name (gensym "ONCE-ONLY-")))
	    `(let ((,,name ,,temp))
	      ,(once-only ,(rest specs) ,@body)))))))


;;; With-unique-names

;;; Automate an idiom often found in macros:
;;;   (LET ((FOO (GENSYM "FOO"))
;;;         (MAX-INDEX (GENSYM "MAX-INDEX-")))
;;;     ...)
;;;
;;; "Good notation eliminates thought." -- Eric Siggia
;;;
;;; Incidentally, this is essentially the same operator which
;;; _On Lisp_ calls WITH-GENSYMS.
(defmacro with-unique-names (symbols &body body)
  `(let ,(mapcar (lambda (symbol)
                   (let* ((symbol-name (symbol-name symbol))
                          (stem (if (every #'alpha-char-p symbol-name)
                                    symbol-name
                                    (concatenate 'string symbol-name "-"))))
                     `(,symbol (gensym ,stem))))
                 symbols)
     ,@body))


;;; EOF
