Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Returning functions

14 views
Skip to first unread message

Hidayet Tunc Simsek

unread,
Aug 10, 1999, 3:00:00 AM8/10/99
to
Hi, I am trying to rewrite the following function without the call to
'eval':


(defun finalize-function (function lambdalist)
(eval`(function
(lambda (obj)
(funcall ,function
,@(mapappend #'(lambda (s)
`(,(make-keyword s) (slot-value obj ',s)))
lambdalist))))))

where

;;; mapappend is like mapcar except that the results are appended
together:
(defun mapappend (fun &rest args)
(if (some #'null args)
()
(append (apply fun (mapcar #'car args))
(apply #'mapappend fun (mapcar #'cdr args)))))


and


;;; make-keyword interns the given symbol in the keyword package
(defun make-keyword (s)
(let ((name (if (symbolp s)
(symbol-name s)
(if (stringp s)
s
(error "make-keyword: invalid argument ~A" s)))))
(intern name (find-package 'keyword))))


The story is that 'finalize-function' is given a function object and a
list of symbols
that the function may take as arguments:

e.g.
----

(setf xxx 1)
(setf f #'(lambda (:a a :b b :c c) xxx))
(let ((xxx 2))
(finalize-function f '(a c)))

The difficulty is to make sure that the function returned by
finalize-function
does not bind values to the symbols that may exist in 'function'. In
the example
I'm worried that the 'xxx' in 'f' may be bound to the wrong value, hence
I use
a global 'eval' call.

The reason I want to do it without 'eval' is to see whether it can be
done.
Any ideas?

Tunc Simsek
sim...@eecs.berkeley.edu

Hidayet Tunc Simsek

unread,
Aug 10, 1999, 3:00:00 AM8/10/99
to
Sorry about the typos:

The corrections are

> (eval`(function
(eval `(function

and

> (setf f #'(lambda (:a a :b b :c c) xxx))

(setf f #'(lambda (&key :a a :b b :c c) xxx))

Vassil Nikolov

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to comp.la...@list.deja.com
Hidayet Tunc Simsek wrote: [1999-08-10 21:31 -0700]

> Sorry about the typos:
>
> The corrections are
>
> > (eval`(function
> (eval `(function

The space is only for humans; the Lisp reader can do without it
(backquote is a terminating macro character).

>
> and
>
> > (setf f #'(lambda (:a a :b b :c c) xxx))
> (setf f #'(lambda (&key :a a :b b :c c) xxx))

This should in fact be (&KEY A B C) or (&KEY ((:A A)) ((:B B)) ((:C C))).

[...]


Vassil Nikolov
Permanent forwarding e-mail: vnik...@poboxes.com
For more: http://www.poboxes.com/vnikolov
Abaci lignei --- programmatici ferrei.

Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.

Vassil Nikolov

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to comp.la...@list.deja.com

Hidayet Tunc Simsek wrote: [1999-08-10 21:03 -0700]

> Hi, I am trying to rewrite the following function without the call to
> 'eval':
>
>
> (defun finalize-function (function lambdalist)

You shouldn't call the second parameter `lambda-list' as it is
just a list of variable names without lambda-list keywords being
allowed.

> (eval`(function
> (lambda (obj)
> (funcall ,function
> ,@(mapappend #'(lambda (s)
> `(,(make-keyword s) (slot-value obj ',s)))
> lambdalist))))))

FINALISE-FUNCTION is not IMO a very good name for this function;
perhaps something like MAKE-FUNCTION-OF-INSTANCE would be
better.

[...]


> ;;; make-keyword interns the given symbol in the keyword package
> (defun make-keyword (s)
> (let ((name (if (symbolp s)
> (symbol-name s)
> (if (stringp s)
> s
> (error "make-keyword: invalid argument ~A" s)))))

If you don't want to write (LET ((NAME (STRING S))) ...), consider

(let ((name (ctypecase s
(symbol (symbol-name s))
(string s))))
...)

or, if you must have your own error message,

(let ((name (typecase s
(symbol (symbol-name s))
(string s)
(otherwise (cerror ...)))))
...)

(I think a continuable error would be better here).

> (intern name (find-package 'keyword))))
[...]


> The reason I want to do it without 'eval' is to see whether it can be
> done.
> Any ideas?

First of all, must the new function be made at run-time?

If so, then there are three options which are not essentially different:
* EVAL (as above);
* COERCE of a lambda-expression into the type FUNCTION (which I'd
prefer);
* COMPILE of NIL and a lambda-expression.

(Note that #'(LAMBDA ...) is not a lambda-expression but a function
object; '(LAMBDA ...) is a lambda-expression.)

But I wonder if it isn't really appropriate to construct the new function
at compile time, and implement a macro for that. It all depends on
what one actually wants to do in the broader context of the whole
program.

Hidayet Tunc Simsek

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
Vassil Nikolov wrote:
>
> Hidayet Tunc Simsek wrote: [1999-08-10 21:31 -0700]
>
> > Sorry about the typos:
> >
> > The corrections are
> >
> > > (eval`(function
> > (eval `(function
>
> The space is only for humans; the Lisp reader can do without it
> (backquote is a terminating macro character).

I didn't know that, thanks.

>
> >
> > and
> >
> > > (setf f #'(lambda (:a a :b b :c c) xxx))
> > (setf f #'(lambda (&key :a a :b b :c c) xxx))
>
> This should in fact be (&KEY A B C) or (&KEY ((:A A)) ((:B B)) ((:C C))).

you are correct, it should be the first option (&key a b c)

Tunc

Barry Margolin

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
In article <37B0F612...@EECS.Berkeley.Edu>,

Hidayet Tunc Simsek <sim...@EECS.Berkeley.Edu> wrote:
>The reason I want to do it without 'eval' is to see whether it can be
>done.
>Any ideas?

You can use (coerce `(lambda ...) 'function). This is defined to be
equivalent to your EVAL.

You can create functions on the fly by simply returning a closure, but I
don't think this can be applied in your case. The closure would have to
have a predefined parameter list, but you're constructing the parameter
list on the fly.

--
Barry Margolin, bar...@bbnplanet.com
GTE Internetworking, Powered by BBN, Burlington, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.

Hidayet Tunc Simsek

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
Barry Margolin wrote:
>
> In article <37B0F612...@EECS.Berkeley.Edu>,
> Hidayet Tunc Simsek <sim...@EECS.Berkeley.Edu> wrote:
> >The reason I want to do it without 'eval' is to see whether it can be
> >done.
> >Any ideas?
>
> You can use (coerce `(lambda ...) 'function). This is defined to be
> equivalent to your EVAL.
>
> You can create functions on the fly by simply returning a closure, but I
> don't think this can be applied in your case. The closure would have to
> have a predefined parameter list, but you're constructing the parameter
> list on the fly.


Actually, the parameter list is fixed, it is 'obj' but the body of the
function is not fixed. One approach I have tried and failed was to do
something like

(finalize-function (function lambda-list)
#'(lambda (obj)
(apply function `(,@(mapappend #'(lambda (s)


`(,(make-keyword s) (slot-value obj
',s)))
lambdalist))))

The difference is 'funcall' -> 'apply'. But in this case the arguments
to the function
are taken literally, so (slot-value obj *) is not taken as the function
call, but instead
literally.

Tunc

Hidayet Tunc Simsek

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
> FINALISE-FUNCTION is not IMO a very good name for this function;
> perhaps something like MAKE-FUNCTION-OF-INSTANCE would be
> better.

The 'finalize' comes from the fact that it is called from
finalize-inheritance
in some class definition.


> If you don't want to write (LET ((NAME (STRING S))) ...), consider
>
> (let ((name (ctypecase s
> (symbol (symbol-name s))
> (string s))))
> ...)
>
> or, if you must have your own error message,
>
> (let ((name (typecase s
> (symbol (symbol-name s))
> (string s)
> (otherwise (cerror ...)))))
> ...)
>
> (I think a continuable error would be better here).

I'm not too worried about the utility functions, although I appreciate
your
suggestions for 'programming style'.


> First of all, must the new function be made at run-time?
>
> If so, then there are three options which are not essentially different:
> * EVAL (as above);
> * COERCE of a lambda-expression into the type FUNCTION (which I'd
> prefer);
> * COMPILE of NIL and a lambda-expression.
>

Yes, since it is called to finalize some functions defined in a class.
I don't think coerce is any different from eval (although I'm not sure
about its semantics). The last option I don't understand.

Tunc

Pekka P. Pirinen

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
Hidayet Tunc Simsek <sim...@EECS.Berkeley.Edu> writes:

> (setf xxx 1)


> (setf f #'(lambda (:a a :b b :c c) xxx))

> (let ((xxx 2))


> (finalize-function f '(a c)))
>
> The difficulty is to make sure that the function returned by
> finalize-function does not bind values to the symbols that may exist

> in 'function' [the first argument].

There's no way it could do that, unless the symbols denoted dynamic
variables in the first place (like the first XXX in your example), and
the constructed function was stupid enough to bind the same dynamic
variable. (The second XXX in your example is lexical, and I don't
quite understand what it is doing.)

> One approach I have tried and failed was to do
> something like
>
> (finalize-function (function lambda-list)

^defun


> #'(lambda (obj)
> (apply function `(,@(mapappend #'(lambda (s)
> `(,(make-keyword s) (slot-value obj
> ',s)))
> lambdalist))))

You don't need that outer backquote. (And you don't need MAPAPPEND,
you can just use MAPCAN, since you're concatenating freshly
constructed lists.)

(defun finalize-function (function lambdalist)
#'(lambda (obj)
(apply function (mapcan #'(lambda (s)
`(,(make-keyword s) ,(slot-value obj s)))
lambdalist))))

It would be more efficient to preconstruct the keywords and reuse
them,
--
Pekka P. Pirinen
Harlequin Limited
Technology is powerful magic, so we all need to become powerful magicians.
- Christopher M. Stahnke <cstahnke_worldbank.org>

Kent M Pitman

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
Vassil Nikolov <v...@einet.bg> writes:

> or, if you must have your own error message,
>
> (let ((name (typecase s
> (symbol (symbol-name s))
> (string s)
> (otherwise (cerror ...)))))
> ...)
>
> (I think a continuable error would be better here).

Well, yes, but it should DO something if continued.

(let ((name (typecase s
(symbol (symbol-name s))
(string s)
(otherwise

(let ((stupid-name (princ-to-string s)))
(cerror "Blunder ahead with ~*~S instead."
"~S is not a symbol or a string."
s)
stupid-name)))))
...)

or [which is approximately the same]:

(let ((name (block dumb
(with-simple-restart (continue "Fake a name and blunder ahead.")
(return-from dumb (string s)))
(princ-to-string s))))
...)

N.B.: For reasons of time, I didn't test either of these pieces of code.

> > (intern name (find-package 'keyword))))

; (1) don't repeatedly look this up at runtime
;
; (2) don't use package names that are symbols in other people's packages
; since that just creates "package clutter"

(defvar *kewyord-package* (find-package "KEYWORD"))

> > The reason I want to do it without 'eval' is to see whether it can be
> > done.
> > Any ideas?
>

> First of all, must the new function be made at run-time?
>
> If so, then there are three options which are not essentially different:
> * EVAL (as above);
> * COERCE of a lambda-expression into the type FUNCTION (which I'd
> prefer);
> * COMPILE of NIL and a lambda-expression.

Don't forget closures and PROGV and other tools which can be used
to simulate pieces of what you want. I didn't look at the original
of this message to see what the request was, so maybe they are not
applicable. I'll try to remember to do that later when I have
more time.

Not using EVAL is always a good goal since it's a big hammer.
However, replacing it with COMPILE doesn't appreciably improve
the big hammer problem... it does potentially make the code
faster if it's going to get used a lot.

Closures (or sometimes instances) should always be your avenue of
first resort if they can be made to work.

Hidayet Tunc Simsek

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
I suppose you could go both ways, in fact I like this solution.
However,
the symbol function is bound to this lexical scope, will this cause a
problem
if 'lambdalist' has a symbol called 'function'. I often get confused
with
these bindings.

Vassil Nikolov wrote:
>
> Pekka P. Pirinen wrote: [1999-08-11 20:51 +0100]
>
> [...]


> > (defun finalize-function (function lambdalist)
> > #'(lambda (obj)
> > (apply function (mapcan #'(lambda (s)
> > `(,(make-keyword s) ,(slot-value obj s)))
> > lambdalist))))
>

> As far as I understand, the argument list must be made^1 when
> the function is made, i.e. when FINALIZE-FUNCTION is called, not
> when the made function (returned by FINALIZE-FUNCTION) is called.
> __________
> ^1 by calling MAPwhatever

Barry Margolin

unread,
Aug 11, 1999, 3:00:00 AM8/11/99
to
In article <37B1FD05...@EECS.Berkeley.Edu>,

Hidayet Tunc Simsek <sim...@EECS.Berkeley.Edu> wrote:
>I suppose you could go both ways, in fact I like this solution.
>However,
>the symbol function is bound to this lexical scope, will this cause a
>problem
>if 'lambdalist' has a symbol called 'function'. I often get confused
>with
>these bindings.

In general, lexical scoping almost always prevents problems with name
clashes like this. That's what makes it so much better than dynamic
scoping: names are only bound in the area of the program textually within
the binding form.

Vassil Nikolov

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to comp.la...@list.deja.com
Hidayet Tunc Simsek wrote: [1999-08-11 10:56 -0700]

[...]


> > * COMPILE of NIL and a lambda-expression.
> >
>

> Yes, since it is called to finalize some functions defined in a class.
> I don't think coerce is any different from eval (although I'm not sure
> about its semantics). The last option I don't understand.

No, COERCE is indeed not different from EVAL with respect to making
functions but it makes the programmer's intent clearer. As to the last one:

(compile nil form-returning-lambda-expression)

produces a function object which would do the same as the result of

(coerce form-returning-lambda-expression 'function)

except that the call to COMPILE will produce a compiled function, i.e.
one which would run faster at the expense of being more slow to make.
(Note: in some implementations, all functions are compiled, so the
call to COERCE might have the same effect.)

Vassil Nikolov

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to comp.la...@list.deja.com
Kent M Pitman wrote: [1999-08-11 19:54 +0000]

> Vassil Nikolov <v...@einet.bg> writes:
[...]


> > (I think a continuable error would be better here).
>
> Well, yes, but it should DO something if continued.

[examples]

Yes, I was trying to promote CERROR while in a hurry and that does
not lead to best results.

[...]


> Don't forget closures and PROGV and other tools which can be used
> to simulate pieces of what you want. I didn't look at the original
> of this message to see what the request was, so maybe they are not
> applicable. I'll try to remember to do that later when I have
> more time.
>
> Not using EVAL is always a good goal since it's a big hammer.
> However, replacing it with COMPILE doesn't appreciably improve
> the big hammer problem... it does potentially make the code
> faster if it's going to get used a lot.

In fact, there does not seem to be a small hammer for making
arbitrary functions on the fly (at run time) as this can't help
needing the full Lisp processor.

> Closures (or sometimes instances) should always be your avenue of
> first resort if they can be made to work.

Having seen now a couple of more posts on this, I am still wondering
about the best way to do it; it does require a significant amount of
run-time effort.

Vassil Nikolov

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to comp.la...@list.deja.com
Pekka P. Pirinen wrote: [1999-08-11 20:51 +0100]

[...]
> (defun finalize-function (function lambdalist)
> #'(lambda (obj)
> (apply function (mapcan #'(lambda (s)
> `(,(make-keyword s) ,(slot-value obj s)))
> lambdalist))))

As far as I understand, the argument list must be made^1 when
the function is made, i.e. when FINALIZE-FUNCTION is called, not
when the made function (returned by FINALIZE-FUNCTION) is called.
__________
^1 by calling MAPwhatever

Howard R. Stearns

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to
Kent M Pitman wrote:
> > > (intern name (find-package 'keyword))))
>
> ; (1) don't repeatedly look this up at runtime
> ;
> ; (2) don't use package names that are symbols in other people's packages
> ; since that just creates "package clutter"
>
> (defvar *kewyord-package* (find-package "KEYWORD"))

It turns out that packages are specifically allowed as externalizable
objects in file processed by compile-file, which means you can also do:

(intern name #.(find-package :keyword))

as well as:

(intern name *keyword-package*)

or even:

(intern name (load-time-value (find-package :keyword)))

The first form is handled by the compiler pretty much like the last,
except that if you have multiple appearances of #.(find-package
:keyword) in the same file, the compiler is free to just do one call to
find-package at load-time. (As opposed to multiple (load-time-value
(find-package :keyword)) forms.)

You should use whatever style you find most appealing, rather than being
overly concerned with officiency. I like the #. approach because it's
an almost invisible two-character change to what you originally wrote
that allows greater efficiency without distracting you.

At the risk of opening up a thread not unlike one that had been here a
while back about defconstant, the #. and load-time-value versions MIGHT
also be more efficient than the defvar version because there doesn't
need to to be any boundp checks as is necesarry for the global variable,
and because the literal MIGHT end up on a less random page in memory
than the *keyword-package* symbol. (As I understand it #. is
potentially exactly the same as using a separate DEFCONSTANT, but it is
up to the compiler.)

H. Tunc Simsek

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to
Just a related question: what is the ANSI way of finding a package;
that is, what is the difference btwn. (find-package 'keyword)
(find-package :keyword)
and (find-package "KEYWORD")

Will all of these work on all lisp implementations?

Tunc

Fred Gilham

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to

I'm writing a logo-to-lisp translator. I'm trying to remain compatible
with a particular implementation that uses dynamic binding. I am
wondering if the method I chose to get dynamic local variables is
correct.

The idea is that in logo one does something like this:

to foo
localmake "bar 2
print :bar
end

If I were to do a let or progv or whatever, I would have to have
everything after the `localmake' be in the scope of the localmake.
But localmake doesn't get access to the forms that come after it when
it gets expanded.

What I'm doing now is the following (look particularly at the use of
the `shadowed-bindings' variable):

(defmacro to (name arglist body)
(let* ((procedure-name (string-upcase (symbol-name name)))
(procedure (intern procedure-name "LOGO"))
(arg-count (length arglist)))
`(progn
(defun ,procedure ,arglist
(declare (special ,@arglist))
(block logo-procedure-exit ; For stop and output.
(let ((shadowed-bindings nil)) ; For binding and unbinding local variables.
,@body)))
(def-logo-procedure ,procedure-name ',procedure :command ,arg-count nil nil nil)
(format t "~A defined.~%" ,procedure-name)
nil)))


(defmacro localmake (word value)
`(let ((w (unquote ,word))
(v ,value)) ; force `value' to be evaluated before `word' is unbound
; in case `value' is an expression containing `word'.
(cond ((null w)
nil)
((atom w)
(if (boundp w)
(progn
(push (cons w (symbol-value w)) shadowed-bindings)
(makunbound w))
(push (cons w *unbound-marker*) shadowed-bindings))
(proclaim '(special w))
(setf (symbol-value w) v))
(t
(error (make-condition 'logo-type-error :argument 'localmake :datum w))))))

(defmacro end ()
"Misc. function-end cleanup. For now, clean up local
variables---unbind them or re-bind them to their old values."
`(progn
(dolist (binding shadowed-bindings)
(if (eq (cdr binding) *unbound-marker*)
(makunbound (car binding))
(setf (symbol-value (car binding)) (cdr binding))))))


I.e. I'm exploiting variable capture. This works, but it seems like a
real kludge. I'm wondering if there's a better way to do it, or if
this is as good as it gets.


--
Fred Gilham gil...@csl.sri.com
How many Analytic Philosophers does it take to change a light bulb?
None---it's a pseudo-problem. Light bulbs give off light (hence the
name). If the bulb was broken and wasn't giving off light, it wouldn't
be a 'light bulb' now would it? (Oh, where has rigor gone?!)

Barry Margolin

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to
In article <37B2FCCA...@EECS.Berkeley.Edu>,

H. Tunc Simsek <sim...@EECS.Berkeley.Edu> wrote:
>Just a related question: what is the ANSI way of finding a package;
>that is, what is the difference btwn. (find-package 'keyword)
>(find-package :keyword)
>and (find-package "KEYWORD")
>
>Will all of these work on all lisp implementations?

They should.

A more interesting case is IN-PACKAGE. In CLTL1, IN-PACKAGE was a
function, but X3J13 changed it to a macro that doesn't evaluate its
argument. Thus, the behavior of:

(in-package 'keyword)

was changed incompatibly. To ensure that a program that uses IN-PACKAGE
will run in both CLTL1 CL and ANSI CL, you should use

(in-package :keyword)

or

(in-package "KEYWORD")

If you have code that uses the single-quoted syntax, it's pretty simple to
do a global replace that changes them to the colon syntax.

Kent M Pitman

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to
"Howard R. Stearns" <how...@citydesktopinc.com> writes:

> Kent M Pitman wrote:
>
> It turns out that packages are specifically allowed as externalizable
> objects in file processed by compile-file, which means you can also do:
> (intern name #.(find-package :keyword))
> as well as:
> (intern name *keyword-package*)
> or even:
> (intern name (load-time-value (find-package :keyword)))

> The first form is handled by the compiler pretty much like the last, [...]

Right. #1 and #3 are effectively the same. I advocate #2 because
philosophically I like the idea that I can change the package in which
the intern happens, even if not through the normal RENAME-PACKAGE
mechanism that I would use if I were doing (intern name "KEYWORD").

This is more important for (defvar *my-package* *package*), of course.
The likelihood of the keyword package needing to be changed/renamed
is very slight and probably negligible. It's just a personal thing,
I guess.

I'd be happier with #, than #.

> At the risk of opening up a thread not unlike one that had been here a
> while back about defconstant, the #. and load-time-value versions MIGHT
> also be more efficient

I agree with this even though I use the other form.

Lieven Marchand

unread,
Aug 12, 1999, 3:00:00 AM8/12/99
to
"H. Tunc Simsek" <sim...@EECS.Berkeley.Edu> writes:

> Just a related question: what is the ANSI way of finding a package;
> that is, what is the difference btwn. (find-package 'keyword)
> (find-package :keyword)
> and (find-package "KEYWORD")
>
> Will all of these work on all lisp implementations?
>

All of them are correct ANSI CL ways of finding a
package. find-package takes as argument a package object or a string
designator. A symbol is a valid string designator. If one of them
doesn't work with an implementation, file a bug report.

The difference is stylistic. If you're in package A and you do
(find-package 'b) the reader will intern symbol B in package A. If you
have a lot of packages and do a lot of package switching you will wind
up with having symbols naming all your packages in every package. A
way to avoid this is using a true string as in (find-package
"B"). Some people don't like the upper case you then have to use and
so a third way is to use symbols in the keyword package as in
(find-package :b).

--
Lieven Marchand <m...@bewoner.dma.be>
If there are aliens, they play Go. -- Lasker

Vassil Nikolov

unread,
Aug 13, 1999, 3:00:00 AM8/13/99
to comp.la...@list.deja.com
Barry Margolin wrote: [1999-08-12 20:36 +0000]

> In article <37B2FCCA...@EECS.Berkeley.Edu>,
> H. Tunc Simsek <sim...@EECS.Berkeley.Edu> wrote:

> >Just a related question: what is the ANSI way of finding a package;
> >that is, what is the difference btwn. (find-package 'keyword)
> >(find-package :keyword)
> >and (find-package "KEYWORD")
> >
> >Will all of these work on all lisp implementations?
>

> They should.
[...]

There is one small detail which makes the third case (with "KEYWORD")
preferrable: if the read case is not the default uppercasing one,^1 one
would get the wrong result with the first two cases.
__________
^1 which is rare but possible; I am not going to argue if it is a good idea or not

Kent M Pitman

unread,
Aug 13, 1999, 3:00:00 AM8/13/99
to
Vassil Nikolov <v...@einet.bg> writes:

> Barry Margolin wrote: [1999-08-12 20:36 +0000]
>
> > In article <37B2FCCA...@EECS.Berkeley.Edu>,
> > H. Tunc Simsek <sim...@EECS.Berkeley.Edu> wrote:
> > >Just a related question: what is the ANSI way of finding a package;
> > >that is, what is the difference btwn. (find-package 'keyword)
> > >(find-package :keyword)
> > >and (find-package "KEYWORD")
> > >
> > >Will all of these work on all lisp implementations?
> >
> > They should.
> [...]
>
> There is one small detail which makes the third case (with "KEYWORD")
> preferrable: if the read case is not the default uppercasing one,^1 one
> would get the wrong result with the first two cases.
> __________
> ^1 which is rare but possible; I am not going to argue if
> it is a good idea or not

Well, of course then you can do (FIND-PACKAGE 'KEYWORD).
After all, if readtable case is set to not upcase, find-package has to
be in the right case, too.

But I wouldn't program defensively about this. After all, no one
should ever surprise anyone else with a change to the case. That is
always a hostile act. Really no different than making the letter "A"
a readmacro character. Programs have to assume the syntax they are
written in will not be changed without warning.

And on the Lisp Machine, there's a variant of Emacs Control-X Control-U
and Control-X Control-L which is called "Uppercase Code in Region" or
"Lowercase Code in Region" and which re-cases the region respecting
doublequotes and comments and backslashed things, so that you can just
change the case at the touch of a button, so such shifts are easy to
accomodate when they do occur and are not worth wasting time worrying
about in advance of the fact.

Howard might [perhaps rightly] claim I should say the same about
#.(find-package "KEYWORD")
Could always be rewritten to something more general if/when I found
a need.

Kent M Pitman

unread,
Aug 13, 1999, 3:00:00 AM8/13/99
to
Fred Gilham <gil...@snapdragon.csl.sri.com> writes:

> I'm writing a logo-to-lisp translator. I'm trying to remain compatible
> with a particular implementation that uses dynamic binding. I am
> wondering if the method I chose to get dynamic local variables is
> correct.

Well, a couple of things. First, I don't see any reason you can't
get the whole program in your hands and just code-walk it as a whole.
When you say:

> If I were to do a let or progv or whatever, I would have to have
> everything after the `localmake' be in the scope of the localmake.
> But localmake doesn't get access to the forms that come after it when
> it gets expanded.

I'm not sure if I really believe this. Yes, syntactically the localmake
doesn't get this, but you as the implementor of the language translator
can have global knowledge. You could do a prepass over the code and
discover what will be done and set that up in advance.

I also don't know if I'd use specials. You might want to just have
variables translate to something other than a variable access. e.g.,
a search through a chain of dynamically bound environments. That's
just an efficiency choice, though. What you're doing might be more
efficient but it might also be more prone to errors.

In particular, you're really setting yourself up for a major disaster
by not preparing for error unwinds. You definitely should check for
an absent "end" at the end of the TO, and you should
make sure to do instead of
(let ((shadowed-local-bindings nil)) ;<--I'd use '() here stylistically
,@body)
something more like:
(let ((shadowed-local-bindings '()))
(unwind-protect (progn ,@body)
(end)))
and then just remove the (end) from the end of the translation since you
presumably have assured it's really there.

But you know, I would just do


(defmacro to (name arglist body)

...
`(defun ,procedure ,arglist
(block logo-procedure-exit
(let ((*logo-env* (new-local-env :parent *logo-env*)))
...))))
and translate each variable reference FOO to
(logo-ref foo)
such that
(defmacro logo-ref (var)
`(logo-lookup ',var))
(defun localmake (var)
`(push (cons var *logo-unbound*) (logo-env-vars *logo-env*)))
(defun logo-lookup (var)
(loop for env = *logo-env* then (logo-env-parent env)
when env
do (let ((entry (assoc var env)))
(if entry (return (cdr entry)))))) ;maybe check unbound here

No, I didn't test any of this.

My point is, though, that this might be less efficient. It does deep
rather than shallow binding, for example. But it's clean if you
unwind the stack by just discarding stack layers. If you do it the
other way, you really have to be sure all your bindings are set up
where you first make sure the restore operation is on shadowed-local-bindings
and then make sure that the unwind-protect is really going to reset
those guys. You don't want to screw this up or your whole environment
will be a mess after the first error. That's probably the part that
feels to you like a kludge.

Howard R. Stearns

unread,
Aug 13, 1999, 3:00:00 AM8/13/99
to
Fred Gilham wrote:
>
> I'm writing a logo-to-lisp translator.

I've always had it on my to-list to learn Logo, but a VERY quick glance
at some Logo doc didn't translate well to my Lisp-addled mind.

Does anyone know of a publicly available "Logo for Lispers" summary?
i.e. an explanation of the quoting and scoping rules, reader-macros,
correspondence of procedure names, etc.

Vassil Nikolov

unread,
Aug 14, 1999, 3:00:00 AM8/14/99
to comp.la...@list.deja.com
Kent M Pitman wrote: [1999-08-13 04:05 +0000]

> Vassil Nikolov <v...@einet.bg> writes:
[...]
> > There is one small detail which makes the third case (with "KEYWORD")
> > preferrable: if the read case is not the default uppercasing one,^1 one
> > would get the wrong result with the first two cases.

[...]


> Well, of course then you can do (FIND-PACKAGE 'KEYWORD).
> After all, if readtable case is set to not upcase, find-package has to
> be in the right case, too.

That is true. A valid example would be much more convoluted.

So the only real reason to say "KEYWORD" remains avoiding the creation
of unnecessary symbols.

Let me just note that if the function name is not in the right case,
it is easier to find the problem than for the datum passed as an
argument, and one can also reasonably expect a warning as early
as compile time.

> But I wouldn't program defensively about this. After all, no one
> should ever surprise anyone else with a change to the case. That is
> always a hostile act. Really no different than making the letter "A"
> a readmacro character. Programs have to assume the syntax they are
> written in will not be changed without warning.

Yes. In fact, truly defensive (read: paranoid) programming would be

(|CL|:|FIND-PACKAGE| '|KEYWORD|)

(still defenseless against changes to the readtable...).

[...]

Erik Naggum

unread,
Aug 14, 1999, 3:00:00 AM8/14/99
to
* Lieven Marchand <m...@bewoner.dma.be>

| A way to avoid this is using a true string as in (find-package "B").
| Some people don't like the upper case you then have to use and so a third
| way is to use symbols in the keyword package as in (find-package :b).

I don't like to type upper-case, don't like to use symbols (including
keywords), and don't want to change my Lisp to use lower-case internally,
so I set up a reader macro that reads the symbol-name the same way the
reader does, but only the name which would have been given to INTERN. in
Allegro CL, this name is returned by EXCL::READ-EXTENDED-TOKEN. as in:
(find-package #"whatever").

this function will parse single and multiple escape, too, of course, but
using both multiple escape when the idea is to avoid using the string
seems silly to me, so I don't recommend #"|GetRandomWindowsCruft|" over
"GetRandomWindowsCruft", but then again, I don't recommend that case-
sensitive symbols be used in Lisp in the first place -- use a more Lispy
name: get-random-windows-cruft.

(in-package :excl)

(loop
with readtables = (get-objects 11)
for i from 1 to (aref readtables 0)
for *readtable* = (aref readtables i)
when (readtable-dispatch-tables *readtable*) do
;; reader for symbol names that does case conversion according to the rest of the symbol reader.
;; thanks to John K. Foderaro for the pointer.
(set-dispatch-macro-character #\# #\"
(named-function symbol-namestring-reader
(lambda (stream character prefix)
(declare (ignore prefix))
(prog1 (read-extended-token stream)
(unless (char= character (read-char stream))
(internal-reader-error stream "invalid symbol-namestring syntax")))))))

#:Erik
--
(defun pringles (chips)
(loop (pop chips)))

Erik Naggum

unread,
Aug 14, 1999, 3:00:00 AM8/14/99
to
* Kent M Pitman <pit...@world.std.com>

| I'd be happier with #, than #.

but #, is history, now, effectively replaced by LOAD-TIME-VALUE, which
means it's probably smart to make a reader macro that re-introduces #, as
a LOAD-TIME-VALUE wrapper around the following form, as ' does for QUOTE.

Kent M Pitman

unread,
Aug 14, 1999, 3:00:00 AM8/14/99
to
Erik Naggum <er...@naggum.no> writes:

> * Kent M Pitman <pit...@world.std.com>
> | I'd be happier with #, than #.
>
> but #, is history, now, effectively replaced by LOAD-TIME-VALUE, which
> means it's probably smart to make a reader macro that re-introduces #, as
> a LOAD-TIME-VALUE wrapper around the following form, as ' does for QUOTE.

Yes, that sounds right. I think we talked about it at the time, and people
weren't that strong on it, but the times might have changed.

(There's certainly precedent for resurrecting things in repaired
fashion after a calculated period of non-use. That's how we "fixed"
CATCH. In Maclisp, now decades ago, it used to not evaluate its tag
argument. We went through many years in Maclisp of using a *CATCH
that did evaluate its argument, and phased out CATCH gradually at that
time. CL felt free to reintroduced CATCH with approximately the
*CATCH semantics (modulo more compulsive tweaking due to multiple
values) without fear of incompatibility with CATCH since the original
CATCH had effectively been deprecated for years.)

0 new messages