Hello all,
consider this..
(setf foo '"hello world")
I could access the the value this way
(symbol-value 'foo)
wonder if i could do something like this with variable setup in a
closure like this.
(let ((foo "hello world)
(bar "hello c.lang.lisp"))
(defun get-value (lst)
(dolist (e lst)
(print (symbol-value e))))
and from outside let i issue
(get-value '(foo bar)) - > i get error variable unbound
I could write individual function for each variables in the closure
but I am looking for shorter way.
I could write the whole thing as an object and benefit from the
accessor and slot-value function but i guess i wanted it done with
closure instead :).
Many thanks.
regards,
George.
In article
<····································@d45g2000hsc.googlegroups.com>,
gtasso <·······@gmail.com> wrote:
> Hello all,
>
> consider this..
>
> (setf foo '"hello world")
>
> I could access the the value this way
> (symbol-value 'foo)
>
> wonder if i could do something like this with variable setup in a
> closure like this.
>
> (let ((foo "hello world)
> (bar "hello c.lang.lisp"))
>
> (defun get-value (lst)
> (dolist (e lst)
> (print (symbol-value e))))
>
> and from outside let i issue
>
> (get-value '(foo bar)) - > i get error variable unbound
Because you can't access lexical variable values
with SYMBOL-VALUE.
>
> I could write individual function for each variables in the closure
> but I am looking for shorter way.
CL-USER 9 > (mapcar (let ((a 1) (b 2))
(flet ((get-value (sym)
(ecase sym
(a a)
(b b))))
#'get-value))
'(b a))
(2 1)
> I could write the whole thing as an object and benefit from the
> accessor and slot-value function but i guess i wanted it done with
> closure instead :).
>
> Many thanks.
>
> regards,
>
> George.
--
http://lispm.dyndns.org/
On Jul 7, 3:06 am, Rainer Joswig <······@lisp.de> wrote:
> In article
> <····································@d45g2000hsc.googlegroups.com>,
>
>
>
> gtasso <·······@gmail.com> wrote:
> > Hello all,
>
> > consider this..
>
> > (setf foo '"hello world")
>
> > I could access the the value this way
> > (symbol-value'foo)
>
> > wonder if i could do something like this with variable setup in a
> > closure like this.
>
> > (let ((foo "hello world)
> > (bar "hello c.lang.lisp"))
>
> > (defun get-value (lst)
> > (dolist (e lst)
> > (print (symbol-valuee))))
>
> > and from outside let i issue
>
> > (get-value '(foo bar)) - > i get error variable unbound
>
> Because you can't accesslexicalvariable values
> withSYMBOL-VALUE.
>
>
>
> > I could write individual function for each variables in the closure
> > but I am looking for shorter way.
>
> CL-USER 9 > (mapcar (let ((a 1) (b 2))
> (flet ((get-value (sym)
> (ecase sym
> (a a)
> (b b))))
> #'get-value))
> '(b a))
> (2 1)
>
> > I could write the whole thing as an object and benefit from the
> > accessor and slot-value function but i guess i wanted it done with
> > closure instead :).
>
> > Many thanks.
>
> > regards,
>
> > George.
>
> --http://lispm.dyndns.org/
This group is positively possessed by super-unnatural forces. So
often it happens that as I type a question, the answer just
materializes to me. And now, my question was answered several days
before it became even actual!
So, here is a macro with which I tried to automate the OP's quest for
automation. I am trying to re-learn to program without objects.
(in-package :my-utils)
(defmacro with-visible-lexs (visible-lexs &optional init-block &body
cases)
"Return function (case-based) with closure & with utility to view
lexical values"
`(let ,visible-lexs
,(when init-block init-block)
(lambda (command &optional args)
(case command
(prop
(ecase args
,@(loop for lex in visible-lexs
collect `(,lex ,lex))))
,@cases))))
Here is a sample session:
MY-UTILS-UNIT-TESTS> (setf *a* (foo 1 3))
#<CLOSURE (SB-C::&OPTIONAL-DISPATCH (LAMBDA #)) {100366F169}>
MY-UTILS-UNIT-TESTS> (apply *a* (list 'sum))
8
MY-UTILS-UNIT-TESTS> (apply *a* (list 'mult))
12
MY-UTILS-UNIT-TESTS> (apply *a* (list 'my-utils::prop 'c))
4
One thing I don't know how to deal with is that the macro uses the
symbol my-utils::prop, since that is where it sits. I don't know how
to go around that.
If anyone has a suggestion for a better name(s), by all means.
Inevitable improvements & suggestions, also (I have not really thought
out if it needs gensym - args & lex may need to be).
Mirko
In article
<····································@p25g2000hsf.googlegroups.com>,
·············@gmail.com wrote:
> On Jul 7, 3:06 am, Rainer Joswig <······@lisp.de> wrote:
> > In article
> > <····································@d45g2000hsc.googlegroups.com>,
> >
> >
> >
> > gtasso <·······@gmail.com> wrote:
> > > Hello all,
> >
> > > consider this..
> >
> > > (setf foo '"hello world")
> >
> > > I could access the the value this way
> > > (symbol-value'foo)
> >
> > > wonder if i could do something like this with variable setup in a
> > > closure like this.
> >
> > > (let ((foo "hello world)
> > > (bar "hello c.lang.lisp"))
> >
> > > (defun get-value (lst)
> > > (dolist (e lst)
> > > (print (symbol-valuee))))
> >
> > > and from outside let i issue
> >
> > > (get-value '(foo bar)) - > i get error variable unbound
> >
> > Because you can't accesslexicalvariable values
> > withSYMBOL-VALUE.
> >
> >
> >
> > > I could write individual function for each variables in the closure
> > > but I am looking for shorter way.
> >
> > CL-USER 9 > (mapcar (let ((a 1) (b 2))
> > (flet ((get-value (sym)
> > (ecase sym
> > (a a)
> > (b b))))
> > #'get-value))
> > '(b a))
> > (2 1)
> >
> > > I could write the whole thing as an object and benefit from the
> > > accessor and slot-value function but i guess i wanted it done with
> > > closure instead :).
> >
> > > Many thanks.
> >
> > > regards,
> >
> > > George.
> >
> > --http://lispm.dyndns.org/
>
> This group is positively possessed by super-unnatural forces. So
> often it happens that as I type a question, the answer just
> materializes to me. And now, my question was answered several days
> before it became even actual!
>
> So, here is a macro with which I tried to automate the OP's quest for
> automation. I am trying to re-learn to program without objects.
>
> (in-package :my-utils)
> (defmacro with-visible-lexs (visible-lexs &optional init-block &body
> cases)
> "Return function (case-based) with closure & with utility to view
> lexical values"
> `(let ,visible-lexs
> ,(when init-block init-block)
> (lambda (command &optional args)
> (case command
> (prop
> (ecase args
> ,@(loop for lex in visible-lexs
> collect `(,lex ,lex))))
> ,@cases))))
>
> Here is a sample session:
>
> MY-UTILS-UNIT-TESTS> (setf *a* (foo 1 3))
> #<CLOSURE (SB-C::&OPTIONAL-DISPATCH (LAMBDA #)) {100366F169}>
> MY-UTILS-UNIT-TESTS> (apply *a* (list 'sum))
> 8
> MY-UTILS-UNIT-TESTS> (apply *a* (list 'mult))
> 12
> MY-UTILS-UNIT-TESTS> (apply *a* (list 'my-utils::prop 'c))
> 4
>
> One thing I don't know how to deal with is that the macro uses the
> symbol my-utils::prop, since that is where it sits. I don't know how
> to go around that.
>
> If anyone has a suggestion for a better name(s), by all means.
> Inevitable improvements & suggestions, also (I have not really thought
> out if it needs gensym - args & lex may need to be).
>
> Mirko
Flavors uses
(send some-window :set-edges 10 10 40 40)
So, use keyword symbols. Use &rest args instead of optional args.
Then you have
(funcall *a* :prop 'c)
In good old style replace funcall with send:
(send *a* :prop 'c)
;-)
--
http://lispm.dyndns.org/
On Jul 8, 3:58 pm, Rainer Joswig <······@lisp.de> wrote:
> In article
> <····································@p25g2000hsf.googlegroups.com>,
>
>
>
> ·············@gmail.com wrote:
> > On Jul 7, 3:06 am, Rainer Joswig <······@lisp.de> wrote:
> > > In article
> > > <····································@d45g2000hsc.googlegroups.com>,
>
> > > gtasso <·······@gmail.com> wrote:
> > > > Hello all,
>
> > > > consider this..
>
> > > > (setf foo '"hello world")
>
> > > > I could access the the value this way
> > > > (symbol-value'foo)
>
> > > > wonder if i could do something like this with variable setup in a
> > > > closure like this.
>
> > > > (let ((foo "hello world)
> > > > (bar "hello c.lang.lisp"))
>
> > > > (defun get-value (lst)
> > > > (dolist (e lst)
> > > > (print (symbol-valuee))))
>
> > > > and from outside let i issue
>
> > > > (get-value '(foo bar)) - > i get error variable unbound
>
> > > Because you can't accesslexicalvariable values
> > > withSYMBOL-VALUE.
>
> > > > I could write individual function for each variables in the closure
> > > > but I am looking for shorter way.
>
> > > CL-USER 9 > (mapcar (let ((a 1) (b 2))
> > > (flet ((get-value (sym)
> > > (ecase sym
> > > (a a)
> > > (b b))))
> > > #'get-value))
> > > '(b a))
> > > (2 1)
>
> > > > I could write the whole thing as an object and benefit from the
> > > > accessor and slot-value function but i guess i wanted it done with
> > > > closure instead :).
>
> > > > Many thanks.
>
> > > > regards,
>
> > > > George.
>
> > > --http://lispm.dyndns.org/
>
> > This group is positively possessed by super-unnatural forces. So
> > often it happens that as I type a question, the answer just
> > materializes to me. And now, my question was answered several days
> > before it became even actual!
>
> > So, here is a macro with which I tried to automate the OP's quest for
> > automation. I am trying to re-learn to program without objects.
>
> > (in-package :my-utils)
> > (defmacro with-visible-lexs (visible-lexs &optional init-block &body
> > cases)
> > "Return function (case-based) with closure & with utility to view
> > lexical values"
> > `(let ,visible-lexs
> > ,(when init-block init-block)
> > (lambda (command &optional args)
> > (case command
> > (prop
> > (ecase args
> > ,@(loop for lex in visible-lexs
> > collect `(,lex ,lex))))
> > ,@cases))))
>
> > Here is a sample session:
>
> > MY-UTILS-UNIT-TESTS> (setf *a* (foo 1 3))
> > #<CLOSURE (SB-C::&OPTIONAL-DISPATCH (LAMBDA #)) {100366F169}>
> > MY-UTILS-UNIT-TESTS> (apply *a* (list 'sum))
> > 8
> > MY-UTILS-UNIT-TESTS> (apply *a* (list 'mult))
> > 12
> > MY-UTILS-UNIT-TESTS> (apply *a* (list 'my-utils::prop 'c))
> > 4
>
> > One thing I don't know how to deal with is that the macro uses the
> > symbol my-utils::prop, since that is where it sits. I don't know how
> > to go around that.
>
> > If anyone has a suggestion for a better name(s), by all means.
> > Inevitable improvements & suggestions, also (I have not really thought
> > out if it needs gensym - args & lex may need to be).
>
> > Mirko
Thanks Rainer,
>
> Flavors uses
What is Flavors? Could not find it on cliki or the web.
>
> (send some-window :set-edges 10 10 40 40)
>
> So, use keyword symbols. Use &rest args instead of optional args.
>
> Then you have
>
> (funcall *a* :prop 'c)
Cool. I keep forgetting about keywords and their package independence
(not cool).
>
> In good old style replace funcall with send:
>
> (send *a* :prop 'c)
>
> ;-)
>
> --http://lispm.dyndns.org/
"send"? I do not find it in hyperspec. Do you mean as an alias for
funcall?
Thanks,
Mirko
In article
<····································@a1g2000hsb.googlegroups.com>,
·············@gmail.com wrote:
> On Jul 8, 3:58 pm, Rainer Joswig <······@lisp.de> wrote:
> > In article
> > <····································@p25g2000hsf.googlegroups.com>,
> >
> >
> >
> > ·············@gmail.com wrote:
> > > On Jul 7, 3:06 am, Rainer Joswig <······@lisp.de> wrote:
> > > > In article
> > > > <····································@d45g2000hsc.googlegroups.com>,
> >
> > > > gtasso <·······@gmail.com> wrote:
> > > > > Hello all,
> >
> > > > > consider this..
> >
> > > > > (setf foo '"hello world")
> >
> > > > > I could access the the value this way
> > > > > (symbol-value'foo)
> >
> > > > > wonder if i could do something like this with variable setup in a
> > > > > closure like this.
> >
> > > > > (let ((foo "hello world)
> > > > > (bar "hello c.lang.lisp"))
> >
> > > > > (defun get-value (lst)
> > > > > (dolist (e lst)
> > > > > (print (symbol-valuee))))
> >
> > > > > and from outside let i issue
> >
> > > > > (get-value '(foo bar)) - > i get error variable unbound
> >
> > > > Because you can't accesslexicalvariable values
> > > > withSYMBOL-VALUE.
> >
> > > > > I could write individual function for each variables in the closure
> > > > > but I am looking for shorter way.
> >
> > > > CL-USER 9 > (mapcar (let ((a 1) (b 2))
> > > > (flet ((get-value (sym)
> > > > (ecase sym
> > > > (a a)
> > > > (b b))))
> > > > #'get-value))
> > > > '(b a))
> > > > (2 1)
> >
> > > > > I could write the whole thing as an object and benefit from the
> > > > > accessor and slot-value function but i guess i wanted it done with
> > > > > closure instead :).
> >
> > > > > Many thanks.
> >
> > > > > regards,
> >
> > > > > George.
> >
> > > > --http://lispm.dyndns.org/
> >
> > > This group is positively possessed by super-unnatural forces. So
> > > often it happens that as I type a question, the answer just
> > > materializes to me. And now, my question was answered several days
> > > before it became even actual!
> >
> > > So, here is a macro with which I tried to automate the OP's quest for
> > > automation. I am trying to re-learn to program without objects.
> >
> > > (in-package :my-utils)
> > > (defmacro with-visible-lexs (visible-lexs &optional init-block &body
> > > cases)
> > > "Return function (case-based) with closure & with utility to view
> > > lexical values"
> > > `(let ,visible-lexs
> > > ,(when init-block init-block)
> > > (lambda (command &optional args)
> > > (case command
> > > (prop
> > > (ecase args
> > > ,@(loop for lex in visible-lexs
> > > collect `(,lex ,lex))))
> > > ,@cases))))
> >
> > > Here is a sample session:
> >
> > > MY-UTILS-UNIT-TESTS> (setf *a* (foo 1 3))
> > > #<CLOSURE (SB-C::&OPTIONAL-DISPATCH (LAMBDA #)) {100366F169}>
> > > MY-UTILS-UNIT-TESTS> (apply *a* (list 'sum))
> > > 8
> > > MY-UTILS-UNIT-TESTS> (apply *a* (list 'mult))
> > > 12
> > > MY-UTILS-UNIT-TESTS> (apply *a* (list 'my-utils::prop 'c))
> > > 4
> >
> > > One thing I don't know how to deal with is that the macro uses the
> > > symbol my-utils::prop, since that is where it sits. I don't know how
> > > to go around that.
> >
> > > If anyone has a suggestion for a better name(s), by all means.
> > > Inevitable improvements & suggestions, also (I have not really thought
> > > out if it needs gensym - args & lex may need to be).
> >
> > > Mirko
>
> Thanks Rainer,
>
> >
> > Flavors uses
>
> What is Flavors? Could not find it on cliki or the web.
http://en.wikipedia.org/wiki/Flavors_%28programming_language%29
Flavors was/is an early extension to Lisp for object-oriented programming.
ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-602.pdf
http://www.softwarepreservation.org/projects/LISP/rutgers/clisp/flavors.pdf
It was oriented towards 'message passing'. Later developed into New Flavors,
which had some influence in the design of CLOS.
> >
> > (send some-window :set-edges 10 10 40 40)
> >
> > So, use keyword symbols. Use &rest args instead of optional args.
> >
> > Then you have
> >
> > (funcall *a* :prop 'c)
>
> Cool. I keep forgetting about keywords and their package independence
> (not cool).
Keywords are not really package independent. Keywords are in the package
"KEYWORD".
CL-USER 1 > (symbol-package :foo)
#<The KEYWORD package, 0/4 internal, 5302/8192 external>
CL-USER 2 > KEYWORD::FOO
:FOO
CL-USER 3 > KEYWORD:FOO
:FOO
CL-USER 4 > :FOO
:FOO
CL-USER 5 > ::FOO
:FOO
The reader will read :foo as a symbol in the keyword package.
The package is missing in front of the : and the symbol, so it will
be the KEYWORD package by default.
>
> >
> > In good old style replace funcall with send:
> >
> > (send *a* :prop 'c)
> >
> > ;-)
> >
> > --http://lispm.dyndns.org/
>
> "send"? I do not find it in hyperspec. Do you mean as an alias for
> funcall?
Yes.
>
> Thanks,
>
> Mirko
--
http://lispm.dyndns.org/
·············@gmail.com writes:
> This group is positively possessed by super-unnatural forces. So
> often it happens that as I type a question, the answer just
> materializes to me. And now, my question was answered several days
> before it became even actual!
>
> So, here is a macro with which I tried to automate the OP's quest for
> automation. I am trying to re-learn to program without objects.
So basically, you just implemented a tiny OO system based on closures
this way:
> (in-package :my-utils)
> (defmacro with-visible-lexs (visible-lexs &optional init-block &body cases)
> "Return function (case-based) with closure & with utility to view lexical values"
> `(let ,visible-lexs
> ,(when init-block init-block)
> (lambda (command &optional args)
> (case command
> (prop
> (ecase args
> ,@(loop for lex in visible-lexs
> collect `(,lex ,lex))))
> ,@cases))))
>
> Here is a sample session:
>
> MY-UTILS-UNIT-TESTS> (setf *a* (foo 1 3))
> #<CLOSURE (SB-C::&OPTIONAL-DISPATCH (LAMBDA #)) {100366F169}>
> MY-UTILS-UNIT-TESTS> (apply *a* (list 'sum))
> 8
> MY-UTILS-UNIT-TESTS> (apply *a* (list 'mult))
> 12
> MY-UTILS-UNIT-TESTS> (apply *a* (list 'my-utils::prop 'c))
> 4
>
> One thing I don't know how to deal with is that the macro uses the
> symbol my-utils::prop, since that is where it sits. I don't know how
> to go around that.
Use STRING= or STRING-EQUAL instead of EQL. CASE uses EQL.
That means, don't use CASE.
> If anyone has a suggestion for a better name(s), by all means.
> Inevitable improvements & suggestions, also (I have not really thought
> out if it needs gensym - args & lex may need to be).
I would rename and extend your macro:
(defmacro define-class (name slots &rest methods)
(let ((slot-names (mapcar (lambda (slot-desc)
(if (listp slot-desc)
(first slot-desc)
slot-desc))
slots))
(slot-inits (mapcar (lambda (slot-desc)
(if (listp slot-desc)
(second slot-desc)
'nil))
slots))
(vmessage (gensym))
(varguments (gensym))
(vnew-value (gensym)))
`(progn
(defun ,(intern (format nil "MAKE-~A" name)
(symbol-package name))
(&key ,@(mapcar (function list) slot-names slot-inits))
(let ,(mapcar (function list) slot-names slot-names)
(lambda (,vmessage &rest ,varguments)
(cond
;; test for messages before accessors so we can
;; override the accessors.
,@(mapcar
(lambda (method)
(destructuring-bind (name arglist &body body) method
`((string= ,vmessage ,(string name))
(destructuring-bind ,arglist ,varguments
,@body))))
methods)
,@(mapcar
(lambda (slot)
;; the getter:
`((string= ,vmessage ,(format nil "GET-~A" slot))
,slot))
slot-names)
,@(mapcar
(lambda (slot)
;; the setter:
`((string= ,vmessage ,(format nil "SET-~A" slot))
(destructuring-bind (,vnew-value) ,varguments
(setf ,slot ,vnew-value))))
slot-names)
((string= ,vmessage "CLASSNAME")
(assert (null ,varguments))
',name)
((string= ,vmessage "SLOTNAMES")
(assert (null ,varguments))
',slot-names)
(t
;; Here, we could forward unknown messages to the superclass
;; we had one...
(error "Unknown message ~A" ,vmessage))))))
;; So now, we can write:
;;
;; (defun square (x) (* x x))
;;
;; (define-class point
;; ((x 0)
;; (y 0)
;; (color (/ 1.0 540e-9))) ; frequency of some green
;; (move (new-x new-y)
;; (let ((v (sqrt (+ (square (- x new-x))
;; (square (- y new-y)))))
;; (c 299792458.0))
;; (setf x new-x
;; y new-y
;; color (let ((z (/ v c)))
;; (/ color (1+ z))))))
;; (set-color (new-color)
;; (assert (and (floatp new-color)
;; ;; must be visible:
;; (<= (/ 1.0 750e-9) new-color (/ 1.0 380e-9))))
;; (setf color new-color)))
;;
;; and we can use it as:
;;
;; (let ((obj (make-point :color 500e-9)))
;; (list
;; (funcall obj 'move 1e8 0)
;; (funcall obj 'set-y 1e8)
;; (funcall obj 'get-color)
;; (funcall obj 'classname)
;; (funcall obj 'slotnames)))
;;
;; --> (#1=3.7493513E-7 1.0E8 #1# POINT (X Y COLOR))
;;
;; but we'd want to have more syntactic sugar.
;; Notice that (funcall obj 'message args)
;; is the same as (send obj 'message args)
;;
;; Let's define message wrapper functions:
,@(mapcar
(lambda (method)
(destructuring-bind (mname arglist &body body) method
(let* ((lambda-list (COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM:PARSE-LAMBDA-LIST arglist))
(args (COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM:make-argument-list lambda-list))
(vself (gensym)))
`(defun ,(if (symbolp mname)
mname
(intern mname (symbol-package name)))
,(cons vself arglist)
,(if (COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM:LAMBDA-LIST-rest-p lambda-list)
`(apply ,vself ',mname ,@args)
`(funcall ,vself ',mname ,@args))))))
methods)
;; And let's define accessors:
,@(mapcar
(lambda (slot)
;; the reader:
`(defun ,slot (self)
(funcall self ,(format nil "GET-~A" slot))))
slot-names)
,@(mapcar
(lambda (slot)
;; the writer:
`(defun (setf ,slot) (new-value self)
(funcall self ,(format nil "SET-~A" slot) new-value)))
slot-names)
',name)))
(defun classname (self) (funcall self 'classname))
(defun slotnames (self) (funcall self 'slotnames))
So finally we can write:
(defun square (x) (* x x))
(define-class point
((x 0)
(y 0)
(color (/ 1.0 540e-9))) ; frequency of some green
(move (new-x new-y)
(let ((v (sqrt (+ (square (- x new-x))
(square (- y new-y)))))
(c 299792458.0))
(setf x new-x
y new-y
color (let ((z (/ v c)))
(/ color (1+ z))))))
(set-color (new-color)
(assert (and (floatp new-color)
;; must be visible:
(<= (/ 1.0 750e-9) new-color (/ 1.0 380e-9))))
(setf color new-color)))
;; and we can use it as:
(let ((obj (make-point :color 500e-9)))
(list
(move obj 1e8 0)
(setf (y obj) 1e8)
(color obj)
(classname obj)
(slotnames obj)))
--> (#1=3.7493513E-7 1.0E8 #1# POINT (X Y COLOR))
Exercise left to the reader: add single inheritance.
Note that (setf (color pt) 0) will call (funcall pt 'set-color 0)
which calls the overridding method, as expected.
Note that as long as the method signature is the same, the generated
accessors can work on objects of different classes (defined by
define-class).
Yes, there is a direct equivalence between OO classes and closures,
and your macro as well as mine explicit it.
--
__Pascal Bourguignon__ http://www.informatimago.com/
Grace personified,
I leap into the window.
I meant to do that.
On Jul 8, 4:14 pm, ····@informatimago.com (Pascal J. Bourguignon)
wrote:
> ·············@gmail.com writes:
> > This group is positively possessed by super-unnatural forces. So
> > often it happens that as I type a question, the answer just
> > materializes to me. And now, my question was answered several days
> > before it became even actual!
>
> > So, here is a macro with which I tried to automate the OP's quest for
> > automation. I am trying to re-learn to program without objects.
>
> So basically, you just implemented a tiny OO system based on closures
> this way:
>
>
>
> > (in-package :my-utils)
> > (defmacro with-visible-lexs (visible-lexs &optional init-block &body cases)
> > "Return function (case-based) with closure & with utility to view lexical values"
> > `(let ,visible-lexs
> > ,(when init-block init-block)
> > (lambda (command &optional args)
> > (case command
> > (prop
> > (ecase args
> > ,@(loop for lex in visible-lexs
> > collect `(,lex ,lex))))
> > ,@cases))))
>
> > Here is a sample session:
>
> > MY-UTILS-UNIT-TESTS> (setf *a* (foo 1 3))
> > #<CLOSURE (SB-C::&OPTIONAL-DISPATCH (LAMBDA #)) {100366F169}>
> > MY-UTILS-UNIT-TESTS> (apply *a* (list 'sum))
> > 8
> > MY-UTILS-UNIT-TESTS> (apply *a* (list 'mult))
> > 12
> > MY-UTILS-UNIT-TESTS> (apply *a* (list 'my-utils::prop 'c))
> > 4
>
> > One thing I don't know how to deal with is that the macro uses the
> > symbol my-utils::prop, since that is where it sits. I don't know how
> > to go around that.
>
> Use STRING= or STRING-EQUAL instead of EQL. CASE uses EQL.
> That means, don't use CASE.
>
> > If anyone has a suggestion for a better name(s), by all means.
> > Inevitable improvements & suggestions, also (I have not really thought
> > out if it needs gensym - args & lex may need to be).
>
> I would rename and extend your macro:
>
> (defmacro define-class (name slots &rest methods)
> (let ((slot-names (mapcar (lambda (slot-desc)
> (if (listp slot-desc)
> (first slot-desc)
> slot-desc))
> slots))
> (slot-inits (mapcar (lambda (slot-desc)
> (if (listp slot-desc)
> (second slot-desc)
> 'nil))
> slots))
> (vmessage (gensym))
> (varguments (gensym))
> (vnew-value (gensym)))
> `(progn
>
> (defun ,(intern (format nil "MAKE-~A" name)
> (symbol-package name))
> (&key ,@(mapcar (function list) slot-names slot-inits))
> (let ,(mapcar (function list) slot-names slot-names)
> (lambda (,vmessage &rest ,varguments)
> (cond
> ;; test for messages before accessors so we can
> ;; override the accessors.
> ,@(mapcar
> (lambda (method)
> (destructuring-bind (name arglist &body body) method
> `((string= ,vmessage ,(string name))
> (destructuring-bind ,arglist ,varguments
> ,@body))))
> methods)
> ,@(mapcar
> (lambda (slot)
> ;; the getter:
> `((string= ,vmessage ,(format nil "GET-~A" slot))
> ,slot))
> slot-names)
> ,@(mapcar
> (lambda (slot)
> ;; the setter:
> `((string= ,vmessage ,(format nil "SET-~A" slot))
> (destructuring-bind (,vnew-value) ,varguments
> (setf ,slot ,vnew-value))))
> slot-names)
> ((string= ,vmessage "CLASSNAME")
> (assert (null ,varguments))
> ',name)
> ((string= ,vmessage "SLOTNAMES")
> (assert (null ,varguments))
> ',slot-names)
> (t
> ;; Here, we could forward unknown messages to the superclass
> ;; we had one...
> (error "Unknown message ~A" ,vmessage))))))
>
> ;; So now, we can write:
> ;;
> ;; (defun square (x) (* x x))
> ;;
> ;; (define-class point
> ;; ((x 0)
> ;; (y 0)
> ;; (color (/ 1.0 540e-9))) ; frequency of some green
> ;; (move (new-x new-y)
> ;; (let ((v (sqrt (+ (square (- x new-x))
> ;; (square (- y new-y)))))
> ;; (c 299792458.0))
> ;; (setf x new-x
> ;; y new-y
> ;; color (let ((z (/ v c)))
> ;; (/ color (1+ z))))))
> ;; (set-color (new-color)
> ;; (assert (and (floatp new-color)
> ;; ;; must be visible:
> ;; (<= (/ 1.0 750e-9) new-color (/ 1.0 380e-9))))
> ;; (setf color new-color)))
> ;;
> ;; and we can use it as:
> ;;
> ;; (let ((obj (make-point :color 500e-9)))
> ;; (list
> ;; (funcall obj 'move 1e8 0)
> ;; (funcall obj 'set-y 1e8)
> ;; (funcall obj 'get-color)
> ;; (funcall obj 'classname)
> ;; (funcall obj 'slotnames)))
> ;;
> ;; --> (#1=3.7493513E-7 1.0E8 #1# POINT (X Y COLOR))
> ;;
> ;; but we'd want to have more syntactic sugar.
> ;; Notice that (funcall obj 'message args)
> ;; is the same as (send obj 'message args)
> ;;
> ;; Let's define message wrapper functions:
>
> ,@(mapcar
> (lambda (method)
> (destructuring-bind (mname arglist &body body) method
> (let* ((lambda-list (COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM:PARSE-LAMBDA-LIST arglist))
> (args (COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM:make-argument-list lambda-list))
> (vself (gensym)))
> `(defun ,(if (symbolp mname)
> mname
> (intern mname (symbol-package name)))
> ,(cons vself arglist)
> ,(if (COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM:LAMBDA-LIST-rest-p lambda-list)
> `(apply ,vself ',mname ,@args)
> `(funcall ,vself ',mname ,@args))))))
> methods)
>
> ;; And let's define accessors:
>
> ,@(mapcar
> (lambda (slot)
> ;; the reader:
> `(defun ,slot (self)
> (funcall self ,(format nil "GET-~A" slot))))
> slot-names)
> ,@(mapcar
> (lambda (slot)
> ;; the writer:
> `(defun (setf ,slot) (new-value self)
> (funcall self ,(format nil "SET-~A" slot) new-value)))
> slot-names)
>
> ',name)))
>
> (defun classname (self) (funcall self 'classname))
> (defun slotnames (self) (funcall self 'slotnames))
>
> So finally we can write:
>
> (defun square (x) (* x x))
>
> (define-class point
> ((x 0)
> (y 0)
> (color (/ 1.0 540e-9))) ; frequency of some green
> (move (new-x new-y)
> (let ((v (sqrt (+ (square (- x new-x))
> (square (- y new-y)))))
> (c 299792458.0))
> (setf x new-x
> y new-y
> color (let ((z (/ v c)))
> (/ color (1+ z))))))
> (set-color (new-color)
> (assert (and (floatp new-color)
> ;; must be visible:
> (<= (/ 1.0 750e-9) new-color (/ 1.0 380e-9))))
> (setf color new-color)))
>
> ;; and we can use it as:
>
> (let ((obj (make-point :color 500e-9)))
> (list
> (move obj 1e8 0)
> (setf (y obj) 1e8)
> (color obj)
> (classname obj)
> (slotnames obj)))
> --> (#1=3.7493513E-7 1.0E8 #1# POINT (X Y COLOR))
>
> Exercise left to the reader: add single inheritance.
>
> Note that (setf (color pt) 0) will call (funcall pt 'set-color 0)
> which calls the overridding method, as expected.
>
> Note that as long as the method signature is the same, the generated
> accessors can work on objects of different classes (defined by
> define-class).
>
> Yes, there is a direct equivalence between OO classes and closures,
> and your macro as well as mine explicit it.
>
> --
> __Pascal Bourguignon__ http://www.informatimago.com/
> Grace personified,
> I leap into the window.
> I meant to do that.
You are right, I implemented a object-lite.
For the past many years, whenever I would start programming something
(in a non-Lisp language, gosh even Fortran 95) no matter how simple, I
would revert to objects. Initially I thought it was cool, but then I
got tired of it. So I am now trying to learn to use closures for some
lighter stuff, and save objects for heavy things (patterns and such).
I'm coming to Paris in october 2010, and we can test your macro over a
bottle of ... (your pick).
Thanks,
Mirko
·············@gmail.com writes:
> You are right, I implemented a object-lite.
>
> For the past many years, whenever I would start programming something
> (in a non-Lisp language, gosh even Fortran 95) no matter how simple, I
> would revert to objects. Initially I thought it was cool, but then I
> got tired of it. So I am now trying to learn to use closures for some
> lighter stuff, and save objects for heavy things (patterns and such).
Note that you can put several functions in the same closure:
(let ((my-simili-object
(let ((x 0)
(y 0))
(list
(lambda (dx dy)
(incf x dx)
(incf y dy))
(lambda ()
(sqrt (+ (* x x) (* y y))))))))
(funcall (first my-simili-object) 3 4)
(funcall (second my-simili-object)))
--> 5
But really, unless you have some higher level function expecting a
function (ie. a closure), usually it's easier to work with structures
or CLOS objects. Even for simple things.
(defstruct cpx
(x 0)
(y 0))
(defmethod incr ((self cpx) dx dy)
(incf (cpx-x self) dx)
(incf (cpx-y self) dy))
(defmethod modulo ((self cpx))
(with-accessors ((x cpx-x) (y cpx-y)) self
(sqrt (+ (* x x) (* y y)))))
(let ((my-simili-object (make-cpx)))
(incr my-simili-object 3 4)
(modulo my-simili-object))
--> 5
It's not more complicated than using the closure, and it's more
modular, you can easily add a method, inspect then objects, you
already have single inheritance with structures, a readable print
representation, etc.
(make-cpx :x 42 :y 24) --> #S(CPX :X 42 :Y 24)
(read-from-string " #S(CPX :X 4 :Y 2)") --> #S(CPX :X 4 :Y 2)
and if your program becomes more complex, you can easily migrate your
structures to CLOS objects.
> I'm coming to Paris in october 2010, and we can test your macro over a
> bottle of ... (your pick).
You're welcome!
--
__Pascal Bourguignon__
On Jul 7, 6:06 pm, Rainer Joswig <······@lisp.de> wrote:
> but I am looking for shorter way.
>
> CL-USER 9 > (mapcar (let ((a 1) (b 2))
> (flet ((get-value (sym)
> (ecase sym
> (a a)
> (b b))))
> #'get-value))
> '(b a))
> (2 1)
>
Ok. That would be great if i have two variable but i have about 16
variable i introduce in the let. I was wondering if 'let' semantically
are label like name spaces so one could reference symbol in that
environemt. e.g if i would like to reference var in cl-user package i
could cl-user::var etc.
Sorry my laziness showing through here :)
Thanks for the suggestion anyway.
regards
George Tasso.
gtasso <·······@gmail.com> writes:
> On Jul 7, 6:06 pm, Rainer Joswig <······@lisp.de> wrote:
>> but I am looking for shorter way.
>>
>> CL-USER 9 > (mapcar (let ((a 1) (b 2))
>> (flet ((get-value (sym)
>> (ecase sym
>> (a a)
>> (b b))))
>> #'get-value))
>> '(b a))
>> (2 1)
>>
>
> Ok. That would be great if i have two variable but i have about 16
> variable i introduce in the let. I was wondering if 'let' semantically
> are label like name spaces so one could reference symbol in that
> environemt. e.g if i would like to reference var in cl-user package i
> could cl-user::var etc.
> Sorry my laziness showing through here :)
Use structures!
> Thanks for the suggestion anyway.
But whatever the number of variables enclosed in the closure (or
object), you shouldn't be accessing them from the exterior. The very
point of enclosing variables inside a closure or object, is to avoid
accessing them from the exterior! The functions who need access to
these variables must be placed INSIDE the closure.
(let ((a 1)
(b 2))
(defun f1 ()
(+ a b))
(defun f2 (c)
(incf a c)
(decf b c))
(defun f3 ()
(- a b)))
--
__Pascal Bourguignon__ http://www.informatimago.com/
You never feed me.
Perhaps I'll sleep on your face.
That will sure show you.
On Jul 10, 9:50 am, ····@informatimago.com (Pascal J. Bourguignon)
wrote:
> The functions who need access to
> these variables must be placed INSIDE the closure.
here is what i was trying to do..
I am looping through database that is franz acache btw.
(let ((basic-total 0) (medical-total 0) (house-allowance-total 0)) ;;
etc as grand total
(doclass* (e 'my-table)
;; i have to incf each 16 variable
;; and it look boring
(incf basic-total (basic e))
(incf medical-total (medical e))
(incf house-allowance-total (house-allowance e)) ))
i want to have a single incrementor function define in the closure so
here goes.
(let ((basic-total 0) (medical-total 0) (house-allowance-total 0)) ;;
etc as grand total
(defun increment (&rest records)
(dolist (record records)
(incf (first record) (second e))))
(doclass* (e 'my-table)
;; so i wish i could only call this one liner
(increment `(basic ,(basic e)) '(medical ,(medical e) `(house-
allowance ,(house-allowance e)))
i am getting this error
Error: `basic-total' is not of the expected type `number'
[condition type: type-error]
pretty normal i guess "basic" wrap in another variable and i i am sort
of calling from inside of (dolist ) form which is an outsider inside a
closure :).
Regards,
George Tasso.
On Wed, 9 Jul 2008 18:13:35 -0700 (PDT), gtasso <·······@gmail.com> said:
| ...
| Error: `basic-total' is not of the expected type `number'
| [condition type: type-error]
And what is the code that you actually ran? And what is the error backtrace?
---Vassil.
--
Peius melius est. ---Ricardus Gabriel.
gtasso <·······@gmail.com> writes:
> On Jul 10, 9:50 am, ····@informatimago.com (Pascal J. Bourguignon)
> wrote:
>> The functions who need access to
>> these variables must be placed INSIDE the closure.
>
> here is what i was trying to do..
>
> I am looping through database that is franz acache btw.
>
> (let ((basic-total 0) (medical-total 0) (house-allowance-total 0)) ;;
> etc as grand total
> (doclass* (e 'my-table)
>
> ;; i have to incf each 16 variable
> ;; and it look boring
>
> (incf basic-total (basic e))
> (incf medical-total (medical e))
> (incf house-allowance-total (house-allowance e)) ))
>
> i want to have a single incrementor function define in the closure so
> here goes.
>
> (let ((basic-total 0) (medical-total 0) (house-allowance-total 0)) ;;
> etc as grand total
>
> (defun increment (&rest records)
> (dolist (record records)
> (incf (first record) (second e))))
>
> (doclass* (e 'my-table)
> ;; so i wish i could only call this one liner
> (increment `(basic ,(basic e)) '(medical ,(medical e) `(house-
> allowance ,(house-allowance e)))
>
> i am getting this error
>
> Error: `basic-total' is not of the expected type `number'
> [condition type: type-error]
>
> pretty normal i guess "basic" wrap in another variable and i i am sort
> of calling from inside of (dolist ) form which is an outsider inside a
> closure :).
No, you could defined increment inside the closure it has access to
the lexical variables of the closure.
But the solution is to use a vector or a hash-table. (You could easily
use a vector if the fields were numbered).
(defparameter *your-columns* '(basic medical house-allowance))
(let ((totals (make-hash-table)))
(doclass* (e 'your-table)
(dolist (accessor *your-columns*)
(incf (gethash accessor totals 0) (funcall accessor e))))
(alexandria:hash-table-alist totals))
--> ((basic . 412412) (medical . 12312) (house-allowance . 31215))
--
__Pascal Bourguignon__ http://www.informatimago.com/
"Specifications are for the weak and timid!"
On Jul 9, 6:33 pm, gtasso <·······@gmail.com> wrote:
> On Jul 7, 6:06 pm, Rainer Joswig <······@lisp.de> wrote:
>
> > but I am looking for shorter way.
>
> > CL-USER 9 > (mapcar (let ((a 1) (b 2))
> > (flet ((get-value (sym)
> > (ecase sym
> > (a a)
> > (b b))))
> > #'get-value))
> > '(b a))
> > (2 1)
>
> Ok. That would be great if i have two variable but i have about 16
> variable i introduce in the let. I was wondering if 'let' semantically
> are label like name spaces so one could reference symbol in that
> environemt. e.g if i would like to reference var in cl-user package i
> could cl-user::var etc.
> Sorry my laziness showing through here :)
> Thanks for the suggestion anyway.
>
> regards
>
> George Tasso.
I cleaned up my previous macro a bit, and it may help you see closed-
over vars.
;; see the ...-unit-tests file for usage example
(defmacro with-visible-lexs (visible-lexs init-block &body cases)
"Returns closure with capability to view lexicals"
`(let ,visible-lexs
,(when init-block init-block)
(lambda (command &rest args)
(case command
(:prop
(ecase (first args)
,@(map 'list #'(lambda (lex) `(,(intern (symbol-name
lex) :keyword) ,lex)) visible-lexs)))
,@cases))))
(defmacro send (closure &rest args)
"Wrapper for funcall closure form - for a slightly friendlier
syntax"
`(funcall ,closure ,@args))
It has not be exhaustively tested, so use with care. For usage
example, see this snippet from my test file that uses lisp-unit
(assert-equal only checks that (send closure ...) returns the expected
values - so you can excise those parts.):
(defun with-visible-lexs-test1 (aa bb)
(with-visible-lexs (a b c)
(progn
(setf a aa)
(setf b bb)
(setf c (+ a b)))
(:mult (* a b c))
(:sum (+ a b c))))
(define-test with-visible-lexs1
(let ((closure (with-visible-lexs-test1 1 3)))
(assert-equal 1 (send closure :prop :a) "a")
(assert-equal 3 (send closure :prop :b) "b")
(assert-equal 4 (send closure :prop :c) "c")
(assert-equal 8 (send closure :sum) "sum")
(assert-equal 12 (send closure :mult) "mult")))
Mirko
On Thu, 10 Jul 2008 08:05:23 -0700 (PDT), ·············@gmail.com said:
| ...
| (defun with-visible-lexs-test1 (aa bb)
| (with-visible-lexs (a b c)
| (progn
| (setf a aa)
| (setf b bb)
| (setf c (+ a b)))
| (:mult (* a b c))
| (:sum (+ a b c))))
This is good, but I would lessen the burden on the programmer---it's
enough to ask for an explicit list of the lexical variables to be
exposed (writing the code walker that would do that automatically is
left as a exercise).
With
(defmacro enclose-exposing-lexicals (lambda-list (&rest vars) &body cases)
`(let ,(mapcar #'list vars vars)
#'(lambda (op ,@lambda-list)
(case op
;; we would cons less if we returned a pair of lists instead:
(:list-lexicals `(,,@(mapcar #'(lambda (var) ``(,',var ,,var)) vars)))
,@cases))))
(I took the liberty of changing the name from WITH-VISIBLE-LEXS) one
can, for example,
(defun make-adder/subtractor (x &aux (y (1- x)))
(enclose-exposing-lexicals (&optional x1) (x y)
(:+ (+ x y))
(:- (- x y))
(:set (setf x x1 y (1- x)) (values x y))))
so that if F is bound to (make-adder/subtractor 3), we have, in order:
(funcall f :+) => 5
(funcall f :-) => 1
(funcall f :list-lexicals) => ((X 3) (Y 2))
(funcall f :set 17) => 17 16
(funcall f :+) => 33
(funcall f :list-lexicals) => ((X 17) (Y 16))
---Vassil.
--
Peius melius est. ---Ricardus Gabriel.
On Thu, 10 Jul 2008 20:03:30 -0400, Vassil Nikolov <···············@pobox.com> said:
| ...
| (defmacro enclose-exposing-lexicals (lambda-list (&rest vars) &body cases)
| `(let ,(mapcar #'list vars vars)
^^^^^^^^^^^^^^^^^^^^^^^^^^
This rebinding does not belong here. I should have finished
cleaning up the code properly before posting...
(And a better name for VARS is EXPOSED-VARS, too.)
| #'(lambda (op ,@lambda-list)
| (case op
| ;; we would cons less if we returned a pair of lists instead:
| (:list-lexicals `(,,@(mapcar #'(lambda (var) ``(,',var ,,var)) vars)))
| ,@cases))))
---Vassil.
--
Peius melius est. ---Ricardus Gabriel.