szymon <···@bar.baz> writes:
> Hi. I rewrote my macro - now it can handle lambda keyword args. Plese
> test/critique it.
1. Your rewrite obviously did not consider my response to your initial post in
Message-Id: <·············@users.sourceforge.net>
Please read it.
2. Furthermore,
>(defun ...
> (unless (fboundp 'memq) (defun memq (item lst) ...
Don't do that. Either you defun at top-level, or you don't.
Same for the ~ defconstant (see my other message).
3. A test case of min
[89]> (defun-curry foo-1 (a b c d) (list a b c d))
FOO-1
[90]> (setq f1 (foo-1 ~ ~ 3 4))
WARNING :
#:G687 is neither declared nor bound,
it will be treated as if it were declared SPECIAL.
WARNING :
#:G686 is neither declared nor bound,
it will be treated as if it were declared SPECIAL.
;; Very probably an indication that something is wrong.
[92]> (setq f2 (foo-1 ~ 2 ~ 4))
[93]> (funcall f1 'a 'b)
(A 2 B 4) -- Oops!
This fails in both old and new versions.
I hardly looked at the new version (too long), sorry
5. I think you've too many globals and specials in a wrong quest for
speed. Go for closures over lexical variables first, they will give
you correctness (and they're fast too, faster than globals).
You'll have to think carefully about each variable: at what time do I
need it? when foo-1 is executed or when the macro is defined? Does it
need to be closed over, i.e. preseved from definition time to
invocation time?
6. about using COMPILE in the code:
> (compile nil (,skeleton ,g-index)))))
I didn't check why this would be needed. I tend to think it's a
misguided attempt to avoid EVAL of which you can read everywhere that
it's evil. Since EVAL is not needed to write your macro (believe me),
I fail to see why COMPILE would be needed.
I'd recommend you restart from your old code (witout &optional
etc. overhead). You can then write the macro in a clear, concise and
correct way (in half a screenful).
I recommend you start by writing the whole code without a single SETQ,
and without seeking any caching.
Regards,
Jorg Hohle
Telekom/T-Systems Technology Center
Hi.
I don't really know how it happened that I overlooked your first post.
Sorry.
---------------------
Thanks for the tips - I intend to follow them. This present post of mine
is rather brief as I am busy at the moment and am afraid that for the next
few days the situation will remain the same.
I know where the error is (in fact, an major omission) that you pointed
out. Its removal should take c. 20 minutes of work (sounds optimistic)...
And later I'll rewrite the whole (I'll also try to give a proper answer
to your posts).
---------------------
As far as COMPILE (or EVAL/COERCE) is concerned, in my opinion it is
necessary (at least I don't have any idea how to solve it in a different
way). The snag is that the macro is to serve the &REST lambda keyword, and
in this connection the maximum number of '~' is not determined in advance.
I know that I could use the &REST in lambda-function which is returned, but
then a user might give more arguments than the earlier '~' - which I want
to _avoid_. In this case, COMPILE is indispensable, in my opinion. I did
not hesitate to use this operator (i.e. COMPILE), the time 'excess' should
be small as compiled are only the necessary elements (besides I memoize
things that I have compiled [1]) - the whole work is performed by the
function '*fill-grafts*'. The globals, which you mentioned, result, among
others, from the fact that COMPILE does not take into consideration the
lexical environment of the compiled content. In this connection, the
information between the dynamically compiled function and the
'*fill-grafts*' is 'transmitted' by globals. To sum up, perhaps I defined
too many globals, but a part of them is indispensable. The code may give
an impression that there are more globals than in reality; those which can
be [2] were 'declared' by me with LET, yet later I use (or abuse) SETQ
which may suggest that the globals are used when they are not.
---------------------
As for SFRI - it is really similar. As can be seen, it is difficult to
discover something original :/ Still, I am happy to have hit upon a good
idea :)
---------------------
Btw, it seems to me that it was useful to implement a part of SFRIs in CL
(or maybe somebody has already done it?). Obviously I mean this part which
is not a faked elements of the CL standard library.
Regards, Szymon.
[1] The first fifty items (functions compiled on request) '~' are memoized
into the vector, the rest is stored in the hash table.
[2] At least it seemed so to me. I have just checked - definitely there are
too many globals.
Joerg Hoehle <······@users.sourceforge.net> writes:
> szymon <···@bar.baz> writes:
>
> > Hi. I rewrote my macro - now it can handle lambda keyword args. Plese
> > test/critique it.
>
> [.....]
>
> 3. A test case of min
> [89]> (defun-curry foo-1 (a b c d) (list a b c d))
> FOO-1
> [90]> (setq f1 (foo-1 ~ ~ 3 4))
> WARNING :
> #:G687 is neither declared nor bound,
> it will be treated as if it were declared SPECIAL.
> WARNING :
> #:G686 is neither declared nor bound,
> it will be treated as if it were declared SPECIAL.
> ;; Very probably an indication that something is wrong.
> [92]> (setq f2 (foo-1 ~ 2 ~ 4))
> [93]> (funcall f1 'a 'b)
> (A 2 B 4) -- Oops!
> This fails in both old and new versions.
with new code:
CL-USER> (defun-curry foo-1 (a b c d) (list a b c d))
; Converted FOO-1.
FOO-1
CL-USER> (setq f1 (foo-1 ~ ~ 3 4))
; Compiling LAMBDA (~::A2P ~::A2Q):
; Compiling Top-Level Form:
#<Function "LAMBDA (~::A2P ~::A2Q)" {587BE9F1}>
CL-USER> (setq f2 (foo-1 ~ 2 ~ 4))
; Compiling LAMBDA (~::A2P ~::A2Q):
; Compiling Top-Level Form:
#<Function "LAMBDA (~::A2P ~::A2Q)" {587D97E1}>
CL-USER> (funcall f1 'a 'b)
(A B 3 4)
CL-USER>
CODE:
;;; defun-curry -- very crude solution :(
;;;
;;; Simplified (no &REST, &KEY, &STUFF).
;;; Bug fixed - thanks to Joerg Hoehle for the report.
;;;
;;; (progn (make-defun-curry) (defun-curry foo (a b c d) (list a b c d)) (setq f1 (foo ~ ~ 3 4) f2 (foo 1 ~ 3 ~)) (values (funcall f1 'a 'b) (funcall f2 'a 'b)))
;;;
;;; ===> (A B 3 4)
;;; ===> (1 A 3 B)
(defmacro make-defun-curry (&key (initial-symb-list-length 99)
(spec-symb-holder '~)
(pac-string "~"))
(let ((d-lst (gensym)) (vector-of-shared-symbol-lists (gensym)) (I (gensym)))
`(progn
(defconstant ,spec-symb-holder (gensym "~S~"))
(defconstant ,vector-of-shared-symbol-lists
(make-array (1+ ,initial-symb-list-length) :element-type 'LIST :initial-element NIL))
(defpackage ,pac-string (:use ,pac-string) (:size ,initial-symb-list-length))
(loop for ,d-lst on (loop for ,I from 0 below ,initial-symb-list-length
collect (let ((*print-base* 36))
(intern (format nil "A~A" ,I) ,pac-string)))
for ,I = ,initial-symb-list-length then (1- ,I)
do (setf (svref ,vector-of-shared-symbol-lists ,I) ,d-lst))
(defmacro defun-curry (name (&rest args) &body body)
(let* ((1-GS '(*hash* *fn* *do-job* skeleton temp-var-1 temp-var-2 ~positions))
(2-GS '(*lambda* *cut-lambda*))
(AS (append 1-GS (copy-list 2-GS))))
(progv AS (loop repeat (length AS) collect (gensym))
(mapc (lambda (symb) (set (symbol-value symb) (gensym))) 2-GS)
`(progn
(defvar ,*lambda*)
(defvar ,*cut-lambda*)
(defvar ,(symbol-value *lambda*))
(defvar ,(symbol-value *cut-lambda*))
(defvar ,*hash* (make-hash-table :size 65 :test #'equal))
(defvar ,*do-job* (lambda (&aux (tail ,(symbol-value *lambda*)))
(loop (if (eq ',,spec-symb-holder (car tail))
(rplaca tail (pop ,(symbol-value *cut-lambda*))))
(unless (setq tail (cdr tail)) (return)))))
(defvar ,*fn* (lambda ,args ,@body))
(flet ((,skeleton
(no-of-args
&aux (skeleton-lambda-list (if (> no-of-args ,,initial-symb-list-length)
(loop repeat no-of-args collect (gensym "A"))
(svref ,,vector-of-shared-symbol-lists no-of-args))))
`(lambda ,skeleton-lambda-list
(setq ,,*cut-lambda* (list ,@skeleton-lambda-list)
,,*lambda* (list
,@(mapcar (lambda (,temp-var-2) `',,temp-var-2)
(symbol-value ,*lambda*))))
(funcall ,,*do-job*)
(apply ,,*fn* ,,*lambda*))))
(let (,temp-var-1)
(defun ,name ,args
(setq ,(symbol-value *lambda*) (list ,@args))
(unless (memq ',,spec-symb-holder ,(symbol-value *lambda*))
(return-from ,name ,@body))
(if (setq ,temp-var-1 (gethash ,(symbol-value *lambda*) ,*hash*))
(return-from ,name ,temp-var-1)
(setf (gethash ,(symbol-value *lambda*) ,*hash*)
(compile nil (,skeleton (count ',,spec-symb-holder ,(symbol-value *lambda*))))))))))))))))
;;; end.
Regards, Szymon.
From: Szymon
Subject: Re: simple defun-curry without COMPILE (was: defun-curry finished. (was: Useful (I hope) trick.))
Date:
Message-ID: <873c3erjn9.fsf_-_@eva.rplacd.net>
Joerg Hoehle <······@users.sourceforge.net> writes:
> I'd recommend you restart from your old code (witout &optional
> etc. overhead). You can then write the macro in a clear, concise and
> correct way (in half a screenful).
>
> I recommend you start by writing the whole code without a single SETQ,
> and without seeking any caching.
Ok. Thanks.
;;; - CODE -
(defmacro make-defun-curry (&key (spec-symb '~))
`(progn (defconstant ,spec-symb (gensym "~S~"))
(defmacro defun-curry (name (&rest args) &body body)
(let ((dc-lambda (gensym)) (rl (gensym)) (rl-copy (gensym)))
`(let (,dc-lambda)
(defun ,name ,args
(setq ,dc-lambda (list ,@args))
(unless (memq ',,spec-symb ,dc-lambda)
(return-from ,name ,@body))
(lambda (&rest ,rl &aux (,rl-copy (copy-tree ,rl)))
(if (/= (list-length ,rl) (count ',,spec-symb ,dc-lambda))
(error "wrong number of args"))
,@(loop for i in args
collect `(if (eq ,i ',,spec-symb)
(setq ,i (pop ,rl-copy))))
,@body))))))))
;;; - END -
CL-USER> (make-defun-curry)
DEFUN-CURRY
CL-USER> (defun-curry foo (a b c d) (list a b c d))
FOO
CL-USER> (setq f1 (foo ~ ~ 3 4) f2 (foo 1 ~ 3 ~))
#<Interpreted Function "DEFUN-CURRY FOO" {58549809}>
CL-USER> (funcall f1 'a 'b)
(A B 3 4)
CL-USER> (funcall f2 'a 'b)
(1 A 3 B)
Regards, Szymon.
From: Joerg Hoehle
Subject: Re: simple defun-curry without COMPILE (was: defun-curry finished. (was: Useful (I hope) trick.))
Date:
Message-ID: <uu0vpa2r3.fsf@users.sourceforge.net>
Szymon <···@bar.baz> writes:
> ;;; - CODE -
> (defmacro make-defun-curry (&key (spec-symb '~))
> `(progn (defconstant ,spec-symb (gensym "~S~"))
> (defmacro defun-curry (name (&rest args) &body body)
> (let ((dc-lambda (gensym)) (rl (gensym)) (rl-copy (gensym)))
> `(let (,dc-lambda)
> (defun ,name ,args
> (setq ,dc-lambda (list ,@args))
> (unless (memq ',,spec-symb ,dc-lambda)
> (return-from ,name ,@body))
> (lambda (&rest ,rl &aux (,rl-copy (copy-tree ,rl)))
> (if (/= (list-length ,rl) (count ',,spec-symb ,dc-lambda))
> (error "wrong number of args"))
> ,@(loop for i in args
> collect `(if (eq ,i ',,spec-symb)
> (setq ,i (pop ,rl-copy))))
> ,@body))))))))
> ;;; - END -
I've only little time, so here are short remarks:
o there's one closing parenthesis too much
o defconstant is going to cause trouble when you repeatedly use the
same symbol.
Dod you want to choose the symbol so that you can learn about
doubly-nested backquotes? :-)
o rl-copy is superfluous. With POP, you don't side-effect the
list. You change only the variable.
o I liked the CASE -> lambda list distinction in your initial
version. Now, a run-time list-length test is inelegant IMHO.
Of course, you could hide that inside the POP loop.
o I haven't checked the consequences of dc-lambda being closed over.
What advantage do you believe it will give the code?
Regards,
Jorg Hohle
Telekom/T-Systems Technology Center
Joerg Hoehle <······@users.sourceforge.net> writes:
Thanks for the reply.
> I've only little time, so here are short remarks:
>
> o there's one closing parenthesis too much
Oh :)
> o defconstant is going to cause trouble when you repeatedly use the
> same symbol.
This is the feature... (I want this).
> Dod you want to choose the symbol so that you can learn about
> doubly-nested backquotes? :-)
:-)
> o rl-copy is superfluous. With POP, you don't side-effect the
> list. You change only the variable.
Ok.
> o I liked the CASE -> lambda list distinction in your initial
> version. Now, a run-time list-length test is inelegant IMHO.
Yes, but you want DEFUN-CURRY "in half screenful" ;) so if I had used CASE
it would have occupied more than about 12-14 lines ;)
Btw, CASE is justified only when I don't want to use &REST (I meant 'full'
(with implementation of lambda-list-keywords) defun-curry).
> ... o I haven't checked the consequences of dc-lambda being closed over.
> What advantage do you believe it will give the code?
If I remember correctly my intention was to correct the bug you pointed
out last time ;)
Regards, Szymon.
Szymon <···@bar.baz> writes:
> > ... o I haven't checked the consequences of dc-lambda being closed over.
> > What advantage do you believe it will give the code?
Any :?)
> If I remember correctly my intention was to correct the bug you pointed
> out last time ;)
not true, sorry...
Joerg Hoehle <······@users.sourceforge.net> writes:
> ... o I liked the CASE -> lambda list distinction in your initial
> version. Now, a run-time list-length test is inelegant IMHO.
> Of course, you could hide that inside the POP loop. ...
;;; - CODE -
(defmacro defun-curry (name (&rest args) &body body) ; 01
(let ((rl (gensym)) (f (gensym)) xx) ; 02
`(flet ((,f ,args ,@body)) ; 03
(defun ,name ,args ; 04
(unless (memq ~ (list ,@args)) ; 05
(return-from ,name ,@body)) ; 06
(case (count ~ (list ,@args)) ; 07
,@(loop for c from 1 upto (length args) collect ; 08
`(,c #'(lambda ; 09
(,@(setq xx ; 10
(loop repeat c collect (gensym))) ; 11
&aux (,rl (list ,@xx)) ; 12
,@(loop for symb in args collect ; 13
`(,symb (if (eq ,symb ~) ; 14
(pop ,rl) ,symb)))) ; 16
(,f ,@args))))))))) ; 17
;;; - END -
;;; SAMPLE MACROEXPANSION:
(defun-curry foo (a b c d) (list a b c d))
===>
(FLET ((#:G2972 (A B C D) (LIST A B C D)))
(DEFUN FOO (A B C D)
(UNLESS (MEMQ ~ (LIST A B C D)) (RETURN-FROM FOO (LIST A B C D)))
(CASE (COUNT ~ (LIST A B C D))
(1 #'(LAMBDA (#:G2973
&AUX (#:G2971 (LIST #:G2973))
(A (IF (EQ A ~) (POP #:G2971) A))
(B (IF (EQ B ~) (POP #:G2971) B))
(C (IF (EQ C ~) (POP #:G2971) C))
(D (IF (EQ D ~) (POP #:G2971) D)))
(#:G2972 A B C D)))
(2 #'(LAMBDA (#:G2974 #:G2975
&AUX (#:G2971 (LIST #:G2974 #:G2975))
(A (IF (EQ A ~) (POP #:G2971) A))
(B (IF (EQ B ~) (POP #:G2971) B))
(C (IF (EQ C ~) (POP #:G2971) C))
(D (IF (EQ D ~) (POP #:G2971) D)))
(#:G2972 A B C D)))
(3 #'(LAMBDA (#:G2976 #:G2977 #:G2978
&AUX (#:G2971 (LIST #:G2976 #:G2977 #:G2978))
(A (IF (EQ A ~) (POP #:G2971) A))
(B (IF (EQ B ~) (POP #:G2971) B))
(C (IF (EQ C ~) (POP #:G2971) C))
(D (IF (EQ D ~) (POP #:G2971) D)))
(#:G2972 A B C D)))
(4 #'(LAMBDA (#:G2979 #:G2980 #:G2981 #:G2982
&AUX (#:G2971 (LIST #:G2979 #:G2980 #:G2981 #:G2982))
(A (IF (EQ A ~) (POP #:G2971) A))
(B (IF (EQ B ~) (POP #:G2971) B))
(C (IF (EQ C ~) (POP #:G2971) C))
(D (IF (EQ D ~) (POP #:G2971) D)))
(#:G2972 A B C D))))))
Regards, Szymon.