Re: trunk r117969: Font-lock `cl-flet*', too.

Re: trunk r117969: Font-lock `cl-flet*', too.

[Thien-Thi Nguyen]

[-- Attachment #1: Type: text/plain, Size: 978 bytes --]

() Leo Liu <sdl.web@gmail.com>
() Sun, 28 Sep 2014 16:13:38 +0800

   I noted this problem some time ago but decided not to fontify
   it so that this nonstandard macro doesn't get much use.

It's hard to judge the efficacy of such subtle negative feedback.

   cl-flet* should probably be removed. Common lisp doesn't have
   this macro. Personally I prefer cl-labels when needing
   something like cl-flet*.

Thanks for the tip (i am ignorant of most things Common Lisp).
I think until the time ‘cl-flet*’ is truly removed from Emacs,
there is no harm in it being fontified like the others, but if
you think otherwise and are willing to start the process for its
eventual removal, feel free to revert the change.

[cc added]

-- 
Thien-Thi Nguyen
   GPG key: 4C807502
   (if you're human and you know it)
      read my lisp: (responsep (questions 'technical)
                               (not (via 'mailing-list)))
                     => nil

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 197 bytes --]

Re: trunk r117969: Font-lock `cl-flet*', too.

[Stefan Monnier]

>    cl-flet* should probably be removed. Common lisp doesn't have
>    this macro. Personally I prefer cl-labels when needing
>    something like cl-flet*.

I mostly agree, but so far the cl-labels macro is not clever enough to
generate as efficient code as cl-flet*.  It would be good to improve
cl-labels with some dependency analysis so that it can generate just as
good code as cl-flet*.


        Stefan

Re: trunk r117969: Font-lock `cl-flet*', too.

[Leo Liu]

On 2014-09-28 12:41 -0400, Stefan Monnier wrote:
> I mostly agree, but so far the cl-labels macro is not clever enough to
> generate as efficient code as cl-flet*.

I didn't realise this.

> It would be good to improve cl-labels with some dependency analysis so
> that it can generate just as good code as cl-flet*.

I compare the expansions of these two forms and they look quite similar
to me. What kind of inefficiency do you have in mind?

(cl-labels ((oddp (x)
              ;; (evenp (1- x))
              (and (integerp x) (not (zerop (/ x 2)))))
            (evenp (x)
              (cl-case x
                (0 t)
                (t (oddp (1- x))))))
  (oddp 13))

(cl-flet* ((oddp (x) (and (integerp x) (not (zerop (/ x 2)))))
           (evenp (x)
             (cl-case x
               (0 t)
               (t (oddp (1- x))))))
  (oddp 13))

Thanks,
Leo

Re: trunk r117969: Font-lock `cl-flet*', too.

[Stefan Monnier]

> I compare the expansions of these two forms and they look quite similar
> to me.  What kind of inefficiency do you have in mind?

Notice the `setq's?  These make a big difference in lexical-binding code
(since they mean that we can't close over the var's value but have to
close over the var's memory location, which gets reified as a cons
cell).


        Stefan

Re: trunk r117969: Font-lock `cl-flet*', too.

[Leo Liu]

On 2014-09-28 21:30 -0400, Stefan Monnier wrote:
> Notice the `setq's?  These make a big difference in lexical-binding code
> (since they mean that we can't close over the var's value but have to
> close over the var's memory location, which gets reified as a cons
> cell).

I see them but didn't know they were inefficient. Would something along
these lines be acceptable? Thanks, Leo

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- lisp/emacs-lisp/cl-macs.el	2014-07-21 01:41:59 +0000
+++ lisp/emacs-lisp/cl-macs.el	2014-09-29 06:37:43 +0000
@@ -1811,6 +1811,20 @@
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
+(defun cl--labels-depend-p (body &optional deps)
+  "Return non-nil if BODY refers to any function in DEPS. "
+  (catch 'exit
+    (let ((newenv (cons (cons 'function
+			      (lambda (f)
+				(and (memq f deps) (throw 'exit t))
+				f))
+			(append (mapcar (lambda (dep)
+					  (cons dep (lambda (&rest _) (throw 'exit t))))
+					deps)
+				macroexpand-all-environment))))
+      (macroexpand-all (macroexp-progn body) newenv))
+    nil))
+
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make local function definitions.
@@ -1855,19 +1869,28 @@
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1) (debug cl-flet))
-  (let ((binds ()) (newenv macroexpand-all-environment))
+  (let ((binds ())
+	(setqs ())
+	(newenv macroexpand-all-environment)
+	(deps (mapcar #'car bindings)))
     (dolist (binding bindings)
       (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
-	(push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+	(if (cl--labels-depend-p (cddr binding) deps)
+	    (progn
+	      (push var binds)
+	      (push `(setq ,var (cl-function (lambda . ,(cdr binding)))) setqs))
+	  (push (list var `(cl-function (lambda . ,(cdr binding)))) binds))
 	(push (cons (car binding)
-                    `(lambda (&rest cl-labels-args)
-                       (cl-list* 'funcall ',var
-                                 cl-labels-args)))
-              newenv)))
-    (macroexpand-all `(letrec ,(nreverse binds) ,@body)
-                     ;; Don't override lexical-let's macro-expander.
-                     (if (assq 'function newenv) newenv
-                       (cons (cons 'function #'cl--labels-convert) newenv)))))
+		    `(lambda (&rest cl-labels-args)
+		       (cl-list* 'funcall ',var cl-labels-args)))
+	      newenv))
+      (pop deps))
+    (macroexpand-all `(let* ,(nreverse binds)
+			,@(nreverse setqs)
+			,@body)
+		     ;; Don't override lexical-let's macro-expander.
+		     (if (assq 'function newenv) newenv
+		       (cons (cons 'function #'cl--labels-convert) newenv)))))
 
 ;; The following ought to have a better definition for use with newer
 ;; byte compilers.

Re: trunk r117969: Font-lock `cl-flet*', too.

[Leo Liu]

On 2014-09-29 14:41 +0800, Leo Liu wrote:
> +			      (lambda (f)
> +				(and (memq f deps) (throw 'exit t))
> +				f))

Can cause infinite loop if f is a lambda. So I have changed this
expansion to something like:

(lambda (f)
  (cond ((memq f deps) (throw 'exit t))
        ((symbolp f) f)
        ;; Fail on the safe side.
        (t (throw 'exit t))))

Leo

Re: trunk r117969: Font-lock `cl-flet*', too.

[Stefan Monnier]

>  \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
>    (declare (indent 1) (debug cl-flet))
> -  (let ((binds ()) (newenv macroexpand-all-environment))
> +  (let ((binds ())
> +	(setqs ())
> +	(newenv macroexpand-all-environment)
> +	(deps (mapcar #'car bindings)))
>      (dolist (binding bindings)
>        (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
> -	(push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
> +	(if (cl--labels-depend-p (cddr binding) deps)
> +	    (progn
> +	      (push var binds)
> +	      (push `(setq ,var (cl-function (lambda . ,(cdr binding)))) setqs))
> +	  (push (list var `(cl-function (lambda . ,(cdr binding)))) binds))
>  	(push (cons (car binding)
> -                    `(lambda (&rest cl-labels-args)
> -                       (cl-list* 'funcall ',var
> -                                 cl-labels-args)))
> -              newenv)))
> -    (macroexpand-all `(letrec ,(nreverse binds) ,@body)
> -                     ;; Don't override lexical-let's macro-expander.
> -                     (if (assq 'function newenv) newenv
> -                       (cons (cons 'function #'cl--labels-convert) newenv)))))
> +		    `(lambda (&rest cl-labels-args)
> +		       (cl-list* 'funcall ',var cl-labels-args)))
> +	      newenv))
> +      (pop deps))
> +    (macroexpand-all `(let* ,(nreverse binds)
> +			,@(nreverse setqs)
> +			,@body)
> +		     ;; Don't override lexical-let's macro-expander.
> +		     (if (assq 'function newenv) newenv
> +		       (cons (cons 'function #'cl--labels-convert) newenv)))))
 
I'd rather not expand each binding twice: the cl--labels-convert
function can collect the dependencies as it does the expansion.

Also, I'd prefer to use `letrec' rather than hardcode its expansion here
(letrec really should be a special-form, so the byte-compiler can
implement it more efficiently).


        Stefan