From: Murthy S Gandikota
Subject: Question about INTERN
Date: 
Message-ID: <1991Jan29.055536.1523@magnus.ircc.ohio-state.edu>
consider the following lisp definitions:

(defstruct house
	rooms
	area)

(setf my-house (make-house :rooms 4 :area 100))

(setf any-house my-house)

(defun get-slot-value (obj slot)
;;this function returns the value of the slot in obj
(PROG (obj1 value)
	(setf obj1 obj)
	(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))
	(setf value (eval `(,(intern (format nil "~a-~a" (type-of obj1) slot)) 
		,obj)))
	(RETURN value)))


(defun put-slot-value (obj slot value)
;;this function over writes the value of a slot
(PROG (obj1)
(setf obj1 obj)
(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))
(eval `(setf (,(intern (format nil "~a-~a" (type-of obj1)) slot)) ,obj) 
	',value))))

(get-slot-value any-house 'rooms) returns 4

whereas

(get-slot-value my-house 'rooms) causes error

put-slot-value also behaves similarly

These functions used to work all right on Symbolics lisp. The errors
 only happen on Vax lisp 3.x!

Can anyone point out the reason? Or, point out other efficient ways to 
implement such functions? 


Thanks

Murthy Gandikota

From: Eliot Handelman
Subject: Re: Question about INTERN
Date: 
Message-ID: <5783@idunno.Princeton.EDU>
In article <·····················@magnus.ircc.ohio-state.edu> ······@magnus.ircc.ohio-state.edu (Murthy S Gandikota) writes:
;
;
;(setf my-house (make-house :rooms 4 :area 100))
;
;(setf any-house my-house)
;
;(defun get-slot-value (obj slot)
;;;this function returns the value of the slot in obj
;(PROG (obj1 value)
;	(setf obj1 obj)
;	(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))
;	(setf value (eval `(,(intern (format nil "~a-~a" (type-of obj1) slot)) 
;		,obj)))
;	(RETURN value)))
;
;(get-slot-value my-house 'rooms) returns error


The problem is that TYPE-OF doesn't guarantee returning the most specific
type of an object, so if this used to work and now doesn't it's almost
certainly because your two TYPE-OF's aren't behaving consistently.
Common Lisp says that (TYPE-OF any-house) might return T.

There's no portable way to find out what the type of an object is.
But if you know the name of the slot then you might also know
the name of the object, which could reduce your overhead.

There's also no portable way to get the name of the structure slot-accessor,
given the structure and the slot. If I know that the structure is HOUSE
and the slot I'm looking for is ROOM, it would be nice to be able to 
get a handle on the accessor without having to build its name yourself,
but it can't be done. If you do go the way of concatenation and interning,
it's better to do this:

(defun build-room-slot-accessor (slot)
   (intern (concatenate 'string "HOUSE-" (symbol-name slot))))

Then rewrite your function as a macro:

(defmacro get-slot-value (obj slot)
  ;;this function returns the value of the slot in obj
  `(,(build-room-slot-accessor slot) ,obj)))

I don't understand what this is supposed to do:
;(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))

If (setq a <a room>) and (setq b a) and (setq c b) then

A ==> <a room>
B ==> <a room> 
C ==> <a room> ;; that is, the same room.
From: Jeff Dalton
Subject: Re: Question about INTERN
Date: 
Message-ID: <4037@skye.ed.ac.uk>
In article <····@idunno.Princeton.EDU> ·····@phoenix.Princeton.EDU (Eliot Handelman) writes:

>The problem is that TYPE-OF doesn't guarantee returning the most specific
>type of an object, so if this used to work and now doesn't it's almost
>certainly because your two TYPE-OF's aren't behaving consistently.

I agree that this is likely to be the right explanation.  However...

>Common Lisp says that (TYPE-OF any-house) might return T.

Actually, according to CLtL II, page 66, TYPE-OF never returns T.
Moreover (page 67), "for any object created by a DEFSTRUCT constructor
function, where the defstruct has the name _name_ and no :TYPE option,
TYPE-OF will return _name_.

This relationship between TYPE-OF and defstruct was also true in
CLtL I.

-- jd
From: Barry Margolin
Subject: Re: Question about INTERN
Date: 
Message-ID: <1991Jan30.225106.26561@Think.COM>
In article <····@skye.ed.ac.uk> ····@aiai.UUCP (Jeff Dalton) writes:
>In article <····@idunno.Princeton.EDU> ·····@phoenix.Princeton.EDU (Eliot Handelman) writes:
>>The problem is that TYPE-OF doesn't guarantee returning the most specific
>>type of an object, so if this used to work and now doesn't it's almost
>>certainly because your two TYPE-OF's aren't behaving consistently.
>
>I agree that this is likely to be the right explanation.  However...

I disagree, although I don't have any good explanation.
After doing (setq my-house any-house), (type-of my-house) and (type-of
any-house) should return the same value.  TYPE-OF doesn't know what
variable was used in the original form, it just sees the object, and it's
the same object in both cases.

To the original poster: when you post a question about an error you've
gotten, it's always a good idea to specify what the error message said.
Also, it would be very helpful if you would indent your program properly so
that the rest of us don't have a hard time reading it.  Also, a few coding
style suggestions: it's usually more correct to use (typep <object> <type>)
than (eq (type-of <object>) <type>), for the reasons that have been
mentioned in previous responses (it's also more concise to use a
specialized type-checking predicate such as SYMBOLP when it's available);
use EQ or EQL when you know that you don't need the generality of EQUAL
(when I read (EQUAL ...) it forces me to think about why EQUAL was used,
whereas EQ is a very simple operation); use SETQ rather than SETF when
setting variables (again, seeing the more general operator forces the
reader to stop and think, although I suspect many people out there would
disagree with me on this particular point, and I sometimes wish the Common
Lisp designers had had the guts to get rid of SETQ); use SYMBOL-VALUE
rather than EVAL when you know that the argument is a symbol (it's usually
more (and never less) efficient, and states your intent more clearly -- in
general, EVAL should only be used as a last resort); don't use PROG unless
you're using the features of at least two of the special forms it combines
(LET, BLOCK, and TAGBODY).

With all this in mind, here's a suggested rewrite of your functions:

(defun get-slot-value (obj slot)
  "Return the value of the specified slot in obj.
Assumes it is a structure whose accessors use the default naming scheme."
  (when (symbolp obj)
    (setq obj (symbol-value obj)))
  (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
	  ',obj)))

(defun put-slot-value (obj slot value)
  "Fills in the value of the specified slot in obj.
Assumes it is a structure whose accessors use the default naming scheme."
  (when (symbolp obj)
    (setq obj (symbol-value obj)))
  (eval `(setf (,(intern (format nil "~a-~a" (type-of obj) slot))
		',obj)
	       ',value)))
--
Barry Margolin, Thinking Machines Corp.

······@think.com
{uunet,harvard}!think!barmar
From: Eliot Handelman
Subject: Re: Question about INTERN
Date: 
Message-ID: <5823@idunno.Princeton.EDU>
In article <······················@Think.COM> ······@think.com (Barry Margolin) writes:
;

;
;(defun get-slot-value (obj slot)
;  "Return the value of the specified slot in obj.
;Assumes it is a structure whose accessors use the default naming scheme."
;  (when (symbolp obj)
;    (setq obj (symbol-value obj)))
;  (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
;	  ',obj)))

Of course, the real error might be something like interning the
accessor in the wrong package.
From: Stefan Bernemann 7549-139
Subject: Re: Question about INTERN
Date: 
Message-ID: <1991Jan31.104246@asterix.fhg.de>
In article <······················@Think.COM>, ······@think.com (Barry
Margolin) writes:
|> [...]
|> general, EVAL should only be used as a last resort); 
|> [...]
|> With all this in mind, here's a suggested rewrite of your functions:
|> 
|> (defun get-slot-value (obj slot)
|>   "Return the value of the specified slot in obj.
|> Assumes it is a structure whose accessors use the default naming
scheme."
|>   (when (symbolp obj)
|>     (setq obj (symbol-value obj)))
|>   (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
|> 	  ',obj)))
What's the use of eval here? Why don't you use
     (apply (intern (slot-accessor-fn-namestring obj slot)) obj nil) 
or something similar?

Stefan

--
Mail: Stefan Bernemann        ! Phone:  +49-231-7549233
      c/o FhG IML Dortmund    ! Fax:    +49-231-7549211
      Emil-Figge-Str. 75      ! Email:  ·····@iml.fhg.de
      D-4600 Dortmund 50, FRG !        
...!{uunet|mcavx}!unido!itwdo!berni
From: Andrew L. M. Shalit
Subject: Re: Question about INTERN
Date: 
Message-ID: <ALMS.91Jan31114032@ministry.cambridge.apple.com>
In article <······················@Think.COM> ······@think.com (Barry Margolin) writes:

   Also, a few coding
   style suggestions: it's usually more correct to use (typep <object> <type>)
   than (eq (type-of <object>) <type>), for the reasons that have been
   mentioned in previous responses (it's also more concise to use a
   specialized type-checking predicate such as SYMBOLP when it's available);
   use EQ or EQL when you know that you don't need the generality of EQUAL
   (when I read (EQUAL ...) it forces me to think about why EQUAL was used,
   whereas EQ is a very simple operation); use SETQ rather than SETF when
   setting variables (again, seeing the more general operator forces the
   reader to stop and think, although I suspect many people out there would
   disagree with me on this particular point, and I sometimes wish the Common
   Lisp designers had had the guts to get rid of SETQ); use SYMBOL-VALUE
   rather than EVAL when you know that the argument is a symbol (it's usually
   more (and never less) efficient, and states your intent more clearly -- in
   general, EVAL should only be used as a last resort); don't use PROG unless
   you're using the features of at least two of the special forms it combines
   (LET, BLOCK, and TAGBODY).

All very good suggestions.

   With all this in mind, here's a suggested rewrite of your functions:

   (defun get-slot-value (obj slot)
     "Return the value of the specified slot in obj.
   Assumes it is a structure whose accessors use the default naming scheme."
     (when (symbolp obj)
       (setq obj (symbol-value obj)))
     (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
	     ',obj)))

Two more suggestions: replace FORMAT with CONCATENATE.  This will
ensure that you don't get screwed by *print-case*.  Also, you can
replace the EVAL with a FUNCALL (going by your "smaller hammer for a
smaller job" theory).  It might also be a good idea to pass a package
argument to INTERN.  All these together give us:


   (defun get-slot-value (obj slot)
     (when (symbolp obj)
       (setq obj (symbol-value obj)))
     (funcall (intern (concatenate 'string
                                   (string (type-of obj))
                                   "-"
                                   (string slot))
                      (symbol-package slot))       ;just a guess!
               obj))
--
From: Barry Margolin
Subject: Re: Question about INTERN
Date: 
Message-ID: <1991Jan31.174839.20943@Think.COM>
In article <··················@ministry.cambridge.apple.com> ····@cambridge.apple.com (Andrew L. M. Shalit) writes:
>In article <······················@Think.COM> ······@think.com (Barry Margolin) writes:
>Two more suggestions: replace FORMAT with CONCATENATE.  This will
>ensure that you don't get screwed by *print-case*.  

Good point.  I've never really liked Common Lisp's CONCATENATE (my guess is
that 95% of the sequences that are concatenated are lists (which already
have APPEND) and strings (in my Symbolics-specific code I prefer
STRING-APPEND)).  Also, in this case it is clumsy because of the need to
use SYMBOL-NAME to convert the symbol to a string.

>						     Also, you can
>replace the EVAL with a FUNCALL (going by your "smaller hammer for a
>smaller job" theory).  

You're right for the GET-SLOT-VALUE case, but unfortunately not
SET-SLOT-VALUE (I realize you weren't talking about this case, I'm just
amplifying).  In this case, there's some enhanced readability from
implementing both GET and SET in similar fashion.

>			It might also be a good idea to pass a package
>argument to INTERN.  All these together give us:
>
>
>   (defun get-slot-value (obj slot)
>     (when (symbolp obj)
>       (setq obj (symbol-value obj)))
>     (funcall (intern (concatenate 'string
>                                   (string (type-of obj))
>                                   "-"
>                                   (string slot))
>                      (symbol-package slot))       ;just a guess!
>               obj))

I actually considered supplying the package argument.  Unfortunately, there
really is no *right* way to do this, which is why it's usually wrong to try
to construct function names using INTERN at runtime.  The package of the
slot argument to {GET,SET}-SLOT-VALUE is not necessarily the package that
the structure was defined in, especially when inheritance is involved.
Consider:

(defstruct personal-inventory
  car
  house)

(setq my-inv (make-personal-inventory :car :oldsmobile :house :condo))

(get-slot-value my-inv 'car)
Error: Undefined function LISP::PERSONAL-INVENTORY-CAR

or on a Symbolics

Error: Attempt to intern BARMAR in locked package COMMON-LISP.

This is because CAR is inherited from the LISP package.  It would probably
be safer to use (symbol-package (type-of obj)), but that can also have
similar problems (although not involving the LISP package, if the program
obeys the rules against redefining built-in Common Lisp symbols, as
described on p.260 of CLtL2).

--
Barry Margolin, Thinking Machines Corp.

······@think.com
{uunet,harvard}!think!barmar
From: Jeff Dalton
Subject: Re: Question about INTERN
Date: 
Message-ID: <4093@skye.ed.ac.uk>
In article <······················@Think.COM> ······@think.com (Barry Margolin) writes:
>STRING-APPEND)).  Also, in this case it is clumsy because of the need to
>use SYMBOL-NAME to convert the symbol to a string.

I use STRING.  More often, I use the function

(defun concat-symbol (&rest parts)
  (intern (apply #'concatenate 'string (mapcar #'string parts))))

-- jeff
From: Scott "TCB" Turner
Subject: Re: Question about INTERN
Date: 
Message-ID: <1991Feb12.184355.11142@aero.org>
In article <····@skye.ed.ac.uk> ····@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))))))))
From: Chris Riesbeck
Subject: Re: Question about INTERN
Date: 
Message-ID: <883@anaxagoras.ils.nwu.edu>
In article <······················@aero.org>, ···@aero.org (Scott "TCB"
Turner) writes:
> In article <····@skye.ed.ac.uk> ····@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.  

Well, if you're going to be that way about it, you might appreciate 
the following string slicing functions, very handy for getting 
substrings without building new strings.  MAKE-SLICE creates the
container and SET-SLICE can be used to move it around like a window
on strings.  Note that with this sharing comes the fact that you can't
just store the slice and expect to stay unchanged if you call SET-SLICE
again later.  However, there are lots of applications where you want
a temporary substring that then gets copied into the final output. A
string substitution function is given below as an example.

;;; (make-slice) => a slice object
;;; (set-slice slice string &key start end) => slice object, adjusted
;;;  so that it looks and prints like the obvious substring of string.
;;;
;;;   (set-slice (make-slice) "abcde" :start 1 :end 3) => "bc"

(defun make-slice ()
  (make-array 0 :adjustable t :element-type 'string-char :fill-pointer t))

(defun set-slice (slice strng &key (start 0) (end (length strng)))
  (adjust-array slice (- end start)
		:displaced-to strng
		:displaced-index-offset start
		:fill-pointer (- end start)))

;;; Example application...
;;; (substring-subst new old string) substitutes every nonoverlapping
;;; occurrence of old with new in string.

(defun substring-subst (new old string)
  (when (> (length old) 0)
    (with-output-to-string (out)
      (do* ((slice (make-slice))
	    (len (length old))
	    (start 0 (+ pos len))
	    (pos (search old string)
		 (search old string :start2 start)))
	   ((null pos) (format out (set-slice slice string :start start)))
	(format out (slice-string slice string :start start :end pos))
	(format out new)))))

Chris
-----
From: Jeff Dalton
Subject: Terminology and style (was Re: Question about INTERN)
Date: 
Message-ID: <4092@skye.ed.ac.uk>
In article <······················@Think.COM> ······@think.com (Barry Margolin) writes:
>(when I read (EQUAL ...) it forces me to think about why EQUAL was used,
>whereas EQ is a very simple operation); use SETQ rather than SETF when
>setting variables (again, seeing the more general operator forces the
>reader to stop and think, although I suspect many people out there would
>disagree with me on this particular point, and I sometimes wish the Common
>Lisp designers had had the guts to get rid of SETQ); 

This is good advice, but unfortunately certain widely-used textbooks
do such things as (1) use EQUAL everywhere to avoid explaining the
difference between EQUAL, EQL, and EQ; (2) claim that SETQ (and CAR
and CDR) are "old fashioned" and seldom used.

My question is this: is it really the case that CAR and CDR are
normally replaced by FIRST and REST in current programming practice?
How about COND, for which the claim has also been made?

Theer may be an sociologically interesting process here, one in
which practice is changed by describing it as having changed already
(assuming that programmers who learn Lisp from those texts go on to
program in the style they've been taught).
From: Bruce R. Miller
Subject: Re: Terminology and style (was Re: Question about INTERN)
Date: 
Message-ID: <2875365341@ARTEMIS.cam.nist.gov>
In article <····@skye.ed.ac.uk>, Jeff Dalton writes: 
> In article <······················@Think.COM> ······@think.com 
>  (Barry Margolin) makes some good comments about EQUAL vs EQ, SETF vs SETQ
> 
> This is good advice, but unfortunately certain widely-used textbooks
> do such things as (1) use EQUAL everywhere to avoid explaining the
> difference between EQUAL, EQL, and EQ; (2) claim that SETQ (and CAR
> and CDR) are "old fashioned" and seldom used.

Redundancy or not, there are many ways to get the same thing done in
Lisp.  A personal annoyance of mine is Charniak,etal. Artificial
Intelligence Programming (2nd ed, which is in CL).  It was interesting
to see thier code for `reinventing' loop. But, to me, VERY annoying to
have to remember yet another iteration syntax while reading the rest of
the book. Granted, the status of LOOP was not clear when they were
writing, and too involved to include in the text. Still... 
Its otherwise a very good text.

> My question is this: is it really the case that CAR and CDR are
> normally replaced by FIRST and REST in current programming practice?
> How about COND, for which the claim has also been made?

I can only speak for myself, but  here's my vote:
I use FIRST, SECOND, & REST for destructuring when I want to emphasize
the `flat'  structure  of  the  list,  that is, when the list represents
some (possibly ordered) sequence of `like' entitities.  I use CAR, CDR,
CxxR, etc, to emphasize a more tree-like structure.  If in the latter
case, the various places have some kind a distinct meaning (and if
its being used `enough'), then I'm inclined to define a set of accessor
macros, or even a defstruct.

> Theer may be an sociologically interesting process here, one in
> which practice is changed by describing it as having changed already
> (assuming that programmers who learn Lisp from those texts go on to
> program in the style they've been taught).

I can believe that! Look at the whole `Lisp is dead' debate. What is the
single most effective thing that is killing lisp [to the extent that it
actually IS dying]? The statement that Lisp is Dead!!!!!
From: Jay Nelson
Subject: Re: Terminology and style (was Re: Question about INTERN)
Date: 
Message-ID: <27B8222F.3C70@wilbur.coyote.trw.com>
In article <····@skye.ed.ac.uk> ····@aiai.UUCP (Jeff Dalton) writes:

>In article <······················@Think.COM> ······@think.com (Barry Margolin) writes:
>> ... (again, seeing the more general operator forces the
>>reader to stop and think...

>My question is this: is it really the case that CAR and CDR are
>normally replaced by FIRST and REST in current programming practice?
>How about COND, for which the claim has also been made?

My preference is always to use the operator which conveys the intent
of the code.  When dealing with lists, I use FIRST and REST.  If for
some reason I am using a cons cell, I use CAR and CDR.

I don't understand the comment about COND.  I use WHEN and UNLESS for
single case instances, IF when I want two outcomes, and COND when a
sequential set of conditions must be evaluated that doesn't fit the CASE
construct.




Jay Nelson  (TRW)  ···@wilbur.coyote.trw.com
From: Jeff Dalton
Subject: Re: Terminology and style (was Re: Question about INTERN)
Date: 
Message-ID: <4115@skye.ed.ac.uk>
In article <·············@wilbur.coyote.trw.com> ···@wiley.UUCP (Jay Nelson) writes:
>In article <····@skye.ed.ac.uk> ····@aiai.UUCP (Jeff Dalton) writes:

>>My question is this: is it really the case that CAR and CDR are
>>normally replaced by FIRST and REST in current programming practice?
>>How about COND, for which the claim has also been made?
>
>My preference is always to use the operator which conveys the intent
>of the code.  When dealing with lists, I use FIRST and REST.  If for
>some reason I am using a cons cell, I use CAR and CDR.

Well, there I disagree.  I don't mind using FIRST and REST, and agree
that they are sometimes clearer, but I see nothing wrong with considering
CAR and CDR as list operations.

I think there is a residual prejudice against CAR and CDR even within
the Lisp community, because they were originally derived from the
names for parts of a machine work on the IBM 704 (I think that was
it).  Some critics of Lisp, and even people who are teaching Lisp as a
language that is "strange", will say that CAR and CDR stand for
"contents of address register" and "contents of decrement register".
They are confusing the origin of a term with its meaning.

>I don't understand the comment about COND.  I use WHEN and UNLESS for
>single case instances, IF when I want two outcomes, and COND when a
>sequential set of conditions must be evaluated that doesn't fit the CASE
>construct.

That's more or less what I do too.

But some people claim that COND is not used except in "old fashioned"
code.  The suggestion seems to be to use nested IFs instead.  Even
though COND is just about the hardest thing in Lisp to read, I don't
think nested IFs are always a good alternative.  On the other hand,
if established practractice really is moving away from COND, I'd like
to know that.  Contrariwise, if the textbooks that claim COND is
obsolete are wrong, I'd like to know _that_.

-- Jeff
From: Marty Hall
Subject: Re: Terminology and style (was Re: Question about INTERN)
Date: 
Message-ID: <1991Feb12.180213.18143@aplcen.apl.jhu.edu>
In article <····@skye.ed.ac.uk> ····@aiai.UUCP (Jeff Dalton) writes:
>
>This is good advice, but unfortunately certain widely-used textbooks
>do such things as (1) use EQUAL everywhere to avoid explaining the
>difference between EQUAL, EQL, and EQ; (2) claim that SETQ (and CAR
>and CDR) are "old fashioned" and seldom used.

I confess to the "equal" sin in the early weeks of the AI classes I
teach. Actually, I'm not sure it is such a terrible iniquity, as long
as I admit the truth later on. Equally (:-), I have no qualms with an
intro LISP text doing this in the early chapters in order to get
the "big ideas" across without getting bogged down in the details.

As to setq/setf for variables, I am ambivalent. Personally, I cannot
break my pre-CL habit of using setq for variables.

>My question is this: is it really the case that CAR and CDR are
>normally replaced by FIRST and REST in current programming practice?

I strongly prefer first/rest if what is being accessed can be best thought
of as a list. My observation of colleagues on AI contracts I work on is
that this appears to be the consensus. However, a cons doesn't have to be
a list, and I have no objection to car/cdr when accessing trees, etc.
Personally, I define my own accessor functions in such cases, but that
is (to me) a perfectly reasonable argument for sometimes using car/cdr
over the more mnemonic first, second, rest.

A quick glance on my shelf shows only the following texts using first/rest
for lists: Winston (_Lisp_, 3rd ed), Hasemer and Domingue (_Common LISP
Programming for AI_), Norvig (_Paradigms of AI Programming_, upcoming)
and Keene, if you count that (_O-O Programming in CL_).

Using car/cdr is Charniak, et al (_AI Programming_), Tatar (_A Programmer's
Guide to CL_), Touretzky (_CL: A Gentle Intro to Symbolic Computation_),
Wilensky (_Common LISPcraft_) and Tanimoto (_The Elements of AI using CL_).

>How about COND, for which the claim has also been made?

I personally use "if" when there is a single "then" and possibly "else"
clause, "cond" when I would need a progn or nested ifs. I tend to use
when/unless also, but have no strong opinion on that.

>Theer may be an sociologically interesting process here, one in
>which practice is changed by describing it as having changed already
>(assuming that programmers who learn Lisp from those texts go on to
>program in the style they've been taught).

This is a good point.

					- Marty Hall
				AI Lab, AAI Corporation and
			The Johns Hopkins University P/T CS Program
From: Jeff Dalton
Subject: Re: Terminology and style (was Re: Question about INTERN)
Date: 
Message-ID: <4118@skye.ed.ac.uk>
In article <······················@aplcen.apl.jhu.edu> ····@aplcen (Marty Hall) writes:
>A quick glance on my shelf shows only the following texts using first/rest
>for lists: Winston (_Lisp_, 3rd ed), Hasemer and Domingue (_Common LISP
>Programming for AI_), Norvig (_Paradigms of AI Programming_, upcoming)
>and Keene, if you count that (_O-O Programming in CL_).
>
>Using car/cdr is Charniak, et al (_AI Programming_), Tatar (_A Programmer's
>Guide to CL_), Touretzky (_CL: A Gentle Intro to Symbolic Computation_),
>Wilensky (_Common LISPcraft_) and Tanimoto (_The Elements of AI using CL_).

I'm impressed.  Thanks for taking the trouble to do this.

BTW, I think Hasemer and Domingue's _Common LISP Programming for AI_
is a particularly interesting book from a certain, sort of sociological,
perspective.

Throughout, they talk about Lisp as if it were an AI toolkit (think
ART, KEE, etc).  Data structures are called knowledge representations,
for example.  This is probably a good idea if you want to encourage
the use of Lisp in AI (where a number of people, for some reason, seem
to think Lisp isn't useful _directly_).  But it runs counter to the
more widespread attempt to move Lisp more into the mainstream.

-- jd
From: Eliot Handelman
Subject: Re: Question about INTERN
Date: 
Message-ID: <5821@idunno.Princeton.EDU>
In article <····@skye.ed.ac.uk> ····@aiai.UUCP (Jeff Dalton) writes:
;In article <····@idunno.Princeton.EDU> ·····@phoenix.Princeton.EDU (Eliot Handelman) writes:
;

;>Common Lisp says that (TYPE-OF any-house) might return T.
;
;Actually, according to CLtL II, page 66, TYPE-OF never returns T.

Yes, I'm wrong, but anyhow CLtL II isn't Common Lisp (or so I've
been led to believe from some recent discussion on the common lisp
mailing list, for as Steele says in the preface, "In no way  does this
book constitute a definitive description of the *forthcoming* ANSI
standards" (pg xii, my asterisks)).

;Moreover (page 67), "for any object created by a DEFSTRUCT constructor
;function, where the defstruct has the name _name_ and no :TYPE option,
;TYPE-OF will return _name_.
;
;This relationship between TYPE-OF and defstruct was also true in
;CLtL I.
;
;-- jd

Yes.
From: Jeff Dalton
Subject: Re: Question about INTERN
Date: 
Message-ID: <4091@skye.ed.ac.uk>
In article <····@idunno.Princeton.EDU> ·····@phoenix.Princeton.EDU (Eliot Handelman) writes:
>In article <····@skye.ed.ac.uk> ····@aiai.UUCP (Jeff Dalton) writes:
>;In article <····@idunno.Princeton.EDU> ·····@phoenix.Princeton.EDU (Eliot Handelman) writes:
>;>Common Lisp says that (TYPE-OF any-house) might return T.
>;
>;Actually, according to CLtL II, page 66, TYPE-OF never returns T.
>
>Yes, I'm wrong, but anyhow CLtL II isn't Common Lisp (or so I've
>been led to believe from some recent discussion on the common lisp
>mailing list, for as Steele says in the preface, "In no way  does this
>book constitute a definitive description of the *forthcoming* ANSI
>standards" (pg xii, my asterisks)).

You're right that CLtL II isn't Common Lisp, as the preface says.  But
CLtL I is as close to definitive as we can get at present, and it also
says TYPE-OF returns the appropriate type for a defstruct.  Moreover,
CLtL II is the best source we have for what X3J13 intends as well as
to what implementations that have tried to follow X3J13 may have done.
I don't think the X3J13 draft is yet sufficiently solid to take over
as the main definition of CL, and so when we have to cite some source
CLtL II is about as good as it gets at present.

The main cases where it's best not to follow CLtL II too closely are
when something appears to be an artifact of the language used in CLtL
II and so not necessarily a reliable account of the language.

However, you are certainly right is steering programmers away from
TYPE-OF.  Barmar has a good suggestion, namely to use (TYPEP x type)
rather than (EQ (TYPE-OF x) type).

-- jeff