Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!think.com!sdd.hp.com!elroy.jpl.nasa.gov!ncar!midway!midway.uchicago.edu!mitchell From: mitchell@tartarus.uchicago.edu (Mitchell Marks) Newsgroups: comp.lang.lisp Subject: Re: string to symbol conversion Message-ID: Date: 24 Jun 91 17:00:54 GMT References: <32436@dime.cs.umass.edu> Sender: news@midway.uchicago.edu (NewsMistress) Reply-To: mitchell@tartarus.uchicago.edu Organization: University of Chicago Computer Science Lines: 170 In-Reply-To: kevin@dime.cs.umass.edu's message of 21 Jun 91 20: 11:33 GMT Here is a set of general purpose functions and variations on this theme. The handling of packages involves some iffy choices, but I think the rest is fairly solid. ---------------- clip here -------------------- ;;; SYMCAT takes one or more constituents (each of which must be either a ;;; symbol, a string, or a nonnegative fixnum) and returns a symbol whose ;;; name is made by concatenating the printnames (for symbols) or contents ;;; (for strings) of the arguments, in the order given, with no separator. ;;; The new symbol is interned in the home package of the first ;;; constituent, if that constituent is a symbol, or else in the current ;;; package (value of *PACKAGE*) if the first constituent is a string. (defun symcat (&rest syms) (insist symcat (not (null syms))) (symcat-symlist syms)) ;;; SYMCAT-SEPARATE takes a separator string (or symbol) and one or more ;;; constituents (symbols, strings, or natural numbers). It returns a ;;; symbol whose name consists of the printnames (of the symbols) or ;;; contents (of the strings) of the constituent arguments, with the ;;; separator inserted in between each succcessive symbol or string. The ;;; separator is not added before the first nor after the last of the ;;; constituent arguments; and if there is only one constituent, the ;;; separator is not used at all. The new symbol is interned in the home ;;; package of the first constituent, if that constituent is a symbol, or ;;; else in the current package (value of *PACKAGE*) if the first ;;; constituent is a string. ;;; SYMCAT-SEPARATE-AUX does the work of SYMCAT-SEPARATE, but takes the ;;; constituents in a list instead of an &rest argument; this makes it ;;; suitable for use by the predefined-separator functions. The test for ;;; null constituent list cannot be left to the lower-level functions, ;;; since at least one implementation (ACL 3.2) tends to come up with the ;;; symbol NIL. (defun symcat-separate (separator &rest constituents) (symcat-separate-aux separator constituents)) (defun symcat-separate-aux (separator constituents) (insist symcat-separate-aux (not (null constituents)) (or (symbolp separator) (stringp separator) (natnump separator))) (symcat-symlist (cons (car constituents) (symcat-interleave separator (cdr constituents))))) (defun symcat-interleave (separator constituents) (if (null constituents) nil (cons separator (cons (car constituents) (symcat-interleave separator (cdr constituents)))))) ;;; The functions SYMCAT-HYPHEN, SYMCAT-STAR, SYMCAT-EQUAL, SYMCAT-PLUS, ;;; SYMCAT-DOT, and SYMCAT-SPACE provide the functionality of ;;; SYMCAT-SEPARATE with predefined separators. Each takes one or more ;;; arguments, which must each be a symbol or string. (defun symcat-hyphen (&rest constituents) (symcat-separate-aux "-" constituents)) (defun symcat-star (&rest constituents) (symcat-separate-aux "*" constituents)) (defun symcat-equal (&rest constituents) (symcat-separate-aux "=" constituents)) (defun symcat-plus (&rest constituents) (symcat-separate-aux "+" constituents)) (defun symcat-dot (&rest constituents) (symcat-separate-aux "." constituents)) (defun symcat-space (&rest constituents) (symcat-separate-aux " " constituents)) ;;; SYMCAT-INTERN is the low-level function ultimately called by all the ;;; higher-level functions defined here; it's the place where INTERN gets ;;; used. The argument SYMLIST must be a non-null list of symbols or ;;; strings, and the argument PKG must be a package. (defun symcat-intern (symlist pkg) (insist symcat-intern (not (null symlist)) (packagep pkg)) (intern (apply #'concatenate 'string (for (item :in symlist) :save (stringify item))) pkg)) (defun stringify (item) (cond ((stringp item) item) ((symbolp item) (string item)) ((natnump item) (format nil "~d" item)) (t (error "~s is not a string, symbol, or natural number" item)))) (defun natnump (item) (and (integerp item) (not (minusp item)))) ;;; SYMCAT-SYMLIST feeds SYMCAT-INTERN. The argument SYMLIST must be a ;;; nonnull list of symbols, strings, or naturalnumbers. The function ;;; determines the package into which the new symbol should be interned, ;;; based on the first member of SYMLIST: if this member is a symbol, its ;;; home package is used, otherwise the current package (value of ;;; *PACKAGE*) is used. (defun symcat-symlist (symlist) (insist symcat-symlist (not (null symlist))) (for (item :in symlist) :do (if (not (or (symbolp item) (stringp item) (natnump item))) (error "~s is not a string, symbol, or natural number" item))) (let ((pkg (if (symbolp (car symlist)) (symbol-package (car symlist)) *package*))) (symcat-intern symlist pkg))) ;;; ----------------------------------------------- #| Oops, I see this uses INSIST; well, it follows: |# ;;; ----------------------------------------------- #| The INSIST macro provides a way of embedding assertions in code, and raising an error when they are not met. This can aid in debugging semantic errors which otherwise do not immediately produce a LISP error. The definition is taken from Inside Case-Based Reasoning. The form is ( INSIST * ) The is a symbol which will not be evaluated, and should normally be the name of the function (etc) within whose definition the INSIST form appears. Each will be evaluated, and an error will be raised if one evaluates to NIL. Example: (defun numeric-function (a b) (insist numeric-function (numberp a) (numberp b)) (+ a (* 5 b))) (numeric-function 4 5) 29 (numeric-function 5 'z) Error: (NUMBERP B) failed in NUMERIC-FUNCTION [1] |# (defmacro insist (fnname &rest exps) `(and ,@(make-insist-forms fnname exps))) (defun make-insist-forms (fnname exps) (and (not (null exps)) (cons `(or ,(car exps) (error "~s failed in ~s" ',(car exps) ',fnname)) (make-insist-forms fnname (cdr exps))))) -- Mitch Marks mitchell@cs.UChicago.EDU --But...but...I can see with my own two eyes that it's... --Hey, who're you gonna believe: *me* or your own two eyes?