emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 25dc93c5c1b 3/3: ; * lisp/emacs-lisp/cconv.el (cconv-convert): Re


From: Mattias Engdegård
Subject: master 25dc93c5c1b 3/3: ; * lisp/emacs-lisp/cconv.el (cconv-convert): Reindent.
Date: Thu, 21 Dec 2023 07:20:41 -0500 (EST)

branch: master
commit 25dc93c5c1bc7df82a9e16dd080667ccb4ba4f45
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    ; * lisp/emacs-lisp/cconv.el (cconv-convert): Reindent.
---
 lisp/emacs-lisp/cconv.el | 577 ++++++++++++++++++++++++-----------------------
 1 file changed, 291 insertions(+), 286 deletions(-)

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 136560f3ef4..1c9b7fc6730 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -330,303 +330,308 @@ places where they originally did not directly appear."
   ;; so we never touch it(unless we enter to the other closure).
   ;;(if (listp form) (print (car form)) form)
   (macroexp--with-extended-form-stack form
-  (pcase form
-    (`(,(and letsym (or 'let* 'let)) ,binders . ,body)
+    (pcase form
+      (`(,(and letsym (or 'let* 'let)) ,binders . ,body)
 
                                        ; let and let* special forms
-     (let ((binders-new '())
-           (new-env env)
-           (new-extend extend))
-
-       (dolist (binder binders)
-         (let* ((value nil)
-               (var (if (not (consp binder))
-                        (prog1 binder (setq binder (list binder)))
-                       (when (cddr binder)
-                         (byte-compile-warn-x
-                          binder
-                          "Malformed `%S' binding: %S"
-                          letsym binder))
-                      (setq value (cadr binder))
-                      (car binder))))
-           (cond
-            ;; Ignore bindings without a valid name.
-            ((not (symbolp var))
-             (byte-compile-warn-x var "attempt to let-bind nonvariable `%S'" 
var))
-            ((or (booleanp var) (keywordp var))
-             (byte-compile-warn-x var "attempt to let-bind constant `%S'" var))
-            (t
-             (let ((new-val
-                   (pcase (cconv--var-classification binder form)
-                      ;; Check if var is a candidate for lambda lifting.
-                      ((and :lambda-candidate
-                            (guard
-                             (progn
-                               (cl-assert (and (eq (car value) 'function)
-                                               (eq (car (cadr value)) 
'lambda)))
-                               (cl-assert (equal (cddr (cadr value))
-                                                 (caar cconv-freevars-alist)))
-                               ;; Peek at the freevars to decide whether
-                               ;; to λ-lift.
-                               (let* ((fvs (cdr (car cconv-freevars-alist)))
-                                      (fun (cadr value))
-                                      (funargs (cadr fun))
-                                      (funcvars (append fvs funargs)))
+       (let ((binders-new '())
+             (new-env env)
+             (new-extend extend))
+
+         (dolist (binder binders)
+           (let* ((value nil)
+                 (var (if (not (consp binder))
+                          (prog1 binder (setq binder (list binder)))
+                         (when (cddr binder)
+                           (byte-compile-warn-x
+                            binder
+                            "Malformed `%S' binding: %S"
+                            letsym binder))
+                        (setq value (cadr binder))
+                        (car binder))))
+             (cond
+              ;; Ignore bindings without a valid name.
+              ((not (symbolp var))
+               (byte-compile-warn-x
+                var "attempt to let-bind nonvariable `%S'" var))
+              ((or (booleanp var) (keywordp var))
+               (byte-compile-warn-x
+                var "attempt to let-bind constant `%S'" var))
+              (t
+               (let ((new-val
+                     (pcase (cconv--var-classification binder form)
+                        ;; Check if var is a candidate for lambda lifting.
+                        ((and :lambda-candidate
+                              (guard
+                               (progn
+                                 (cl-assert
+                                  (and (eq (car value) 'function)
+                                       (eq (car (cadr value)) 'lambda)))
+                                 (cl-assert (equal (cddr (cadr value))
+                                                   (caar 
cconv-freevars-alist)))
+                                 ;; Peek at the freevars to decide whether
+                                 ;; to λ-lift.
+                                 (let* ((fvs (cdr (car cconv-freevars-alist)))
+                                        (fun (cadr value))
+                                        (funargs (cadr fun))
+                                        (funcvars (append fvs funargs)))
                                        ; lambda lifting condition
-                                 (and fvs (>= cconv-liftwhen
-                                             (length funcvars)))))))
+                                   (and fvs (>= cconv-liftwhen
+                                               (length funcvars)))))))
                                        ; Lift.
-                       (let* ((fvs (cdr (pop cconv-freevars-alist)))
-                              (fun (cadr value))
-                              (funargs (cadr fun))
-                              (funcvars (append fvs funargs))
-                              (funcbody (cddr fun))
-                              (funcbody-env ()))
-                         (push `(,var . (apply-partially ,var . ,fvs)) new-env)
-                         (dolist (fv fvs)
-                           (cl-pushnew fv new-extend)
-                           (if (and (eq 'car-safe (car-safe
-                                                   (cdr (assq fv env))))
-                                    (not (memq fv funargs)))
-                               (push `(,fv . (car-safe ,fv)) funcbody-env)))
-                         `(function (lambda ,funcvars .
-                                      ,(cconv--convert-funcbody
-                                        funargs funcbody funcbody-env 
value)))))
-
-                      ;; Check if it needs to be turned into a "ref-cell".
-                      (:captured+mutated
-                       ;; Declared variable is mutated and captured.
-                       (push `(,var . (car-safe ,var)) new-env)
-                       `(list ,(cconv-convert value env extend)))
-
-                      ;; Check if it needs to be turned into a "ref-cell".
-                      (:unused
-                       ;; Declared variable is unused.
-                       (if (assq var new-env)
-                           (push `(,var) new-env)) ;FIXME:Needed?
-                       (let* ((Ignore (if (symbol-with-pos-p var)
-                                          (position-symbol 'ignore var)
-                                        'ignore))
-                              (newval `(,Ignore
-                                        ,(cconv-convert value env extend)))
-                              (msg (cconv--warn-unused-msg var "variable")))
-                         (if (null msg) newval
-                           (macroexp--warn-wrap var msg newval 'lexical))))
-
-                      ;; Normal default case.
-                      (_
-                       (if (assq var new-env) (push `(,var) new-env))
-                       (cconv-convert value env extend)))))
-
-               (when (and (eq letsym 'let*) (memq var new-extend))
-                 ;; One of the lambda-lifted vars is shadowed, so add
-                 ;; a reference to the outside binding and arrange to use
-                 ;; that reference.
-                 (let ((var-def (cconv--lifted-arg var env))
-                       (closedsym (make-symbol (format "closed-%s" var))))
-                   (setq new-env (cconv--remap-llv new-env var closedsym))
-                   ;; FIXME: `closedsym' doesn't need to be added to `extend'
-                   ;; but adding it makes it easier to write the assertion at
-                   ;; the beginning of this function.
-                   (setq new-extend (cons closedsym (remq var new-extend)))
-                   (push `(,closedsym ,var-def) binders-new)))
-
-               ;; We push the element after redefined free variables are
-               ;; processed.  This is important to avoid the bug when free
-               ;; variable and the function have the same name.
-               (push (list var new-val) binders-new)
-
-               (when (eq letsym 'let*)
-                 (setq env new-env)
-                 (setq extend new-extend))))))
-         )                           ; end of dolist over binders
-
-       (when (not (eq letsym 'let*))
-         ;; We can't do the cconv--remap-llv at the same place for let and
-         ;; let* because in the case of `let', the shadowing may occur
-         ;; before we know that the var will be in `new-extend' (bug#24171).
-         (dolist (binder binders-new)
-           (when (memq (car-safe binder) new-extend)
-             ;; One of the lambda-lifted vars is shadowed.
-             (let* ((var (car-safe binder))
-                    (var-def (cconv--lifted-arg var env))
-                    (closedsym (make-symbol (format "closed-%s" var))))
-               (setq new-env (cconv--remap-llv new-env var closedsym))
-               (setq new-extend (cons closedsym (remq var new-extend)))
-               (push `(,closedsym ,var-def) binders-new)))))
-
-       `(,letsym ,(nreverse binders-new)
-                 . ,(mapcar (lambda (form)
-                              (cconv-convert
-                               form new-env new-extend))
-                            body))))
+                         (let* ((fvs (cdr (pop cconv-freevars-alist)))
+                                (fun (cadr value))
+                                (funargs (cadr fun))
+                                (funcvars (append fvs funargs))
+                                (funcbody (cddr fun))
+                                (funcbody-env ()))
+                           (push `(,var . (apply-partially ,var . ,fvs))
+                                 new-env)
+                           (dolist (fv fvs)
+                             (cl-pushnew fv new-extend)
+                             (if (and (eq 'car-safe (car-safe
+                                                     (cdr (assq fv env))))
+                                      (not (memq fv funargs)))
+                                 (push `(,fv . (car-safe ,fv)) funcbody-env)))
+                           `(function
+                             (lambda ,funcvars
+                               . ,(cconv--convert-funcbody
+                                   funargs funcbody funcbody-env value)))))
+
+                        ;; Check if it needs to be turned into a "ref-cell".
+                        (:captured+mutated
+                         ;; Declared variable is mutated and captured.
+                         (push `(,var . (car-safe ,var)) new-env)
+                         `(list ,(cconv-convert value env extend)))
+
+                        ;; Check if it needs to be turned into a "ref-cell".
+                        (:unused
+                         ;; Declared variable is unused.
+                         (if (assq var new-env)
+                             (push `(,var) new-env)) ;FIXME:Needed?
+                         (let* ((Ignore (if (symbol-with-pos-p var)
+                                            (position-symbol 'ignore var)
+                                          'ignore))
+                                (newval `(,Ignore
+                                          ,(cconv-convert value env extend)))
+                                (msg (cconv--warn-unused-msg var "variable")))
+                           (if (null msg) newval
+                             (macroexp--warn-wrap var msg newval 'lexical))))
+
+                        ;; Normal default case.
+                        (_
+                         (if (assq var new-env) (push `(,var) new-env))
+                         (cconv-convert value env extend)))))
+
+                 (when (and (eq letsym 'let*) (memq var new-extend))
+                   ;; One of the lambda-lifted vars is shadowed, so add
+                   ;; a reference to the outside binding and arrange to use
+                   ;; that reference.
+                   (let ((var-def (cconv--lifted-arg var env))
+                         (closedsym (make-symbol (format "closed-%s" var))))
+                     (setq new-env (cconv--remap-llv new-env var closedsym))
+                     ;; FIXME: `closedsym' doesn't need to be added to `extend'
+                     ;; but adding it makes it easier to write the assertion at
+                     ;; the beginning of this function.
+                     (setq new-extend (cons closedsym (remq var new-extend)))
+                     (push `(,closedsym ,var-def) binders-new)))
+
+                 ;; We push the element after redefined free variables are
+                 ;; processed.  This is important to avoid the bug when free
+                 ;; variable and the function have the same name.
+                 (push (list var new-val) binders-new)
+
+                 (when (eq letsym 'let*)
+                   (setq env new-env)
+                   (setq extend new-extend))))))
+           )                           ; end of dolist over binders
+
+         (when (not (eq letsym 'let*))
+           ;; We can't do the cconv--remap-llv at the same place for let and
+           ;; let* because in the case of `let', the shadowing may occur
+           ;; before we know that the var will be in `new-extend' (bug#24171).
+           (dolist (binder binders-new)
+             (when (memq (car-safe binder) new-extend)
+               ;; One of the lambda-lifted vars is shadowed.
+               (let* ((var (car-safe binder))
+                      (var-def (cconv--lifted-arg var env))
+                      (closedsym (make-symbol (format "closed-%s" var))))
+                 (setq new-env (cconv--remap-llv new-env var closedsym))
+                 (setq new-extend (cons closedsym (remq var new-extend)))
+                 (push `(,closedsym ,var-def) binders-new)))))
+
+         `(,letsym ,(nreverse binders-new)
+                   . ,(mapcar (lambda (form)
+                                (cconv-convert
+                                 form new-env new-extend))
+                              body))))
                                        ;end of let let* forms
 
-                                  ; first element is lambda expression
-    (`(,(and `(lambda . ,_) fun) . ,args)
-     ;; FIXME: it's silly to create a closure just to call it.
-     ;; Running byte-optimize-form earlier would resolve this.
-     `(funcall
-       ,(cconv-convert `(function ,fun) env extend)
-       ,@(mapcar (lambda (form)
-                   (cconv-convert form env extend))
-                 args)))
-
-    (`(cond . ,cond-forms)              ; cond special form
-     `(,(car form) . ,(mapcar (lambda (branch)
-                                (mapcar (lambda (form)
-                                          (cconv-convert form env extend))
-                                        branch))
-                              cond-forms)))
-
-    (`(function (lambda ,args . ,body) . ,rest)
-     (let* ((docstring (if (eq :documentation (car-safe (car body)))
-                           (cconv-convert (cadr (pop body)) env extend)))
-            (bf (if (stringp (car body)) (cdr body) body))
-            (if (when (eq 'interactive (car-safe (car bf)))
-                  (gethash form cconv--interactive-form-funs)))
-            (wrapped (pcase if (`#'(lambda (&rest _cconv--dummy) .,_) t) (_ 
nil)))
-            (cif (when if (cconv-convert if env extend)))
-            (cf nil))
-       ;; TODO: Because we need to non-destructively modify body, this code
-       ;; is particularly ugly.  This should ideally be moved to
-       ;; cconv--convert-function.
-       (pcase cif
-         ('nil (setq bf nil))
-         (`#',f
-          (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
-            (setq bf `((,f1 . (,(if wrapped (nth 2 f) cif) . ,f2)) . ,f3)))
-          (setq cif nil))
-         ;; The interactive form needs special treatment, so the form
-         ;; inside the `interactive' won't be used any further.
-         (_ (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
-              (setq bf `((,f1 . (nil . ,f2)) . ,f3)))))
-       (when bf
-         ;; If we modified bf, re-build body and form as
-         ;; copies with the modified bits.
-         (setq body (if (stringp (car body))
-                        (cons (car body) bf)
-                      bf)
-               form `(function (lambda ,args . ,body) . ,rest))
-         ;; Also, remove the current old entry on the alist, replacing
-         ;; it with the new one.
-         (let ((entry (pop cconv-freevars-alist)))
-           (push (cons body (cdr entry)) cconv-freevars-alist)))
-       (setq cf (cconv--convert-function args body env form docstring))
-       (if (not cif)
-           ;; Normal case, the interactive form needs no special treatment.
-           cf
-         `(cconv--interactive-helper
-           ,cf ,(if wrapped cif `(list 'quote ,cif))))))
-
-    (`(internal-make-closure . ,_)
-     (byte-compile-report-error
-      "Internal error in compiler: cconv called twice?"))
-
-    (`(quote . ,_) form)
-    (`(function . ,_) form)
+                                        ; first element is lambda expression
+      (`(,(and `(lambda . ,_) fun) . ,args)
+       ;; FIXME: it's silly to create a closure just to call it.
+       ;; Running byte-optimize-form earlier would resolve this.
+       `(funcall
+         ,(cconv-convert `(function ,fun) env extend)
+         ,@(mapcar (lambda (form)
+                     (cconv-convert form env extend))
+                   args)))
+
+      (`(cond . ,cond-forms)              ; cond special form
+       `(,(car form) . ,(mapcar (lambda (branch)
+                                  (mapcar (lambda (form)
+                                            (cconv-convert form env extend))
+                                          branch))
+                                cond-forms)))
+
+      (`(function (lambda ,args . ,body) . ,rest)
+       (let* ((docstring (if (eq :documentation (car-safe (car body)))
+                             (cconv-convert (cadr (pop body)) env extend)))
+              (bf (if (stringp (car body)) (cdr body) body))
+              (if (when (eq 'interactive (car-safe (car bf)))
+                    (gethash form cconv--interactive-form-funs)))
+              (wrapped (pcase if (`#'(lambda (&rest _cconv--dummy) .,_) t)))
+              (cif (when if (cconv-convert if env extend)))
+              (cf nil))
+         ;; TODO: Because we need to non-destructively modify body, this code
+         ;; is particularly ugly.  This should ideally be moved to
+         ;; cconv--convert-function.
+         (pcase cif
+           ('nil (setq bf nil))
+           (`#',f
+            (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+              (setq bf `((,f1 . (,(if wrapped (nth 2 f) cif) . ,f2)) . ,f3)))
+            (setq cif nil))
+           ;; The interactive form needs special treatment, so the form
+           ;; inside the `interactive' won't be used any further.
+           (_ (pcase-let ((`((,f1 . (,_ . ,f2)) . ,f3) bf))
+                (setq bf `((,f1 . (nil . ,f2)) . ,f3)))))
+         (when bf
+           ;; If we modified bf, re-build body and form as
+           ;; copies with the modified bits.
+           (setq body (if (stringp (car body))
+                          (cons (car body) bf)
+                        bf)
+                 form `(function (lambda ,args . ,body) . ,rest))
+           ;; Also, remove the current old entry on the alist, replacing
+           ;; it with the new one.
+           (let ((entry (pop cconv-freevars-alist)))
+             (push (cons body (cdr entry)) cconv-freevars-alist)))
+         (setq cf (cconv--convert-function args body env form docstring))
+         (if (not cif)
+             ;; Normal case, the interactive form needs no special treatment.
+             cf
+           `(cconv--interactive-helper
+             ,cf ,(if wrapped cif `(list 'quote ,cif))))))
+
+      (`(internal-make-closure . ,_)
+       (byte-compile-report-error
+        "Internal error in compiler: cconv called twice?"))
+
+      (`(quote . ,_) form)
+      (`(function . ,_) form)
 
                                        ;defconst, defvar
-    (`(,(and sym (or 'defconst 'defvar)) ,definedsymbol . ,forms)
-     `(,sym ,definedsymbol
-            . ,(when (consp forms)
-                 (cons (cconv-convert (car forms) env extend)
-                       ;; The rest (i.e. docstring, of any) is not evaluated,
-                       ;; and may be an invalid expression (e.g. ($# . 678)).
-                       (cdr forms)))))
+      (`(,(and sym (or 'defconst 'defvar)) ,definedsymbol . ,forms)
+       `(,sym ,definedsymbol
+              . ,(when (consp forms)
+                   (cons (cconv-convert (car forms) env extend)
+                         ;; The rest (i.e. docstring, of any) is not evaluated,
+                         ;; and may be an invalid expression (e.g. ($# . 678)).
+                         (cdr forms)))))
 
                                         ; condition-case
-    (`(condition-case ,var ,protected-form . ,handlers)
-     (let* ((class (and var (cconv--var-classification (list var) form)))
-            (newenv
-             (cond ((eq class :captured+mutated)
-                    (cons `(,var . (car-safe ,var)) env))
-                   ((assq var env) (cons `(,var) env))
-                   (t env)))
-            (msg (when (eq class :unused)
-                   (cconv--warn-unused-msg var "variable")))
-            (newprotform (cconv-convert protected-form env extend)))
-       `(,(car form) ,var
-            ,(if msg
-                 (macroexp--warn-wrap var msg newprotform 'lexical)
-               newprotform)
-          ,@(mapcar
-             (lambda (handler)
-               `(,(car handler)
-                 ,@(let ((body
-                          (mapcar (lambda (form)
-                                    (cconv-convert form newenv extend))
-                                  (cdr handler))))
-                     (if (not (eq class :captured+mutated))
-                         body
-                       `((let ((,var (list ,var))) ,@body))))))
-             handlers))))
-
-    (`(unwind-protect ,form1 . ,body)
-     `(,(car form) ,(cconv-convert form1 env extend)
-        :fun-body ,(cconv--convert-function () body env form1)))
-
-    (`(setq ,var ,expr)
-     (let ((var-new (or (cdr (assq var env)) var))
-           (value (cconv-convert expr env extend)))
-       (pcase var-new
-         ((pred symbolp) `(,(car form) ,var-new ,value))
-         (`(car-safe ,iexp) `(setcar ,iexp ,value))
-         ;; This "should never happen", but for variables which are
-         ;; mutated+captured+unused, we may end up trying to `setq'
-         ;; on a closed-over variable, so just drop the setq.
-         (_ ;; (byte-compile-report-error
-          ;;  (format "Internal error in cconv of (setq %s ..)"
-          ;;          sym-new))
-          value))))
-
-    (`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
-     ;; These are not special forms but we treat them separately for the needs
-     ;; of lambda lifting.
-     (let ((mapping (cdr (assq fun env))))
-       (pcase mapping
-         (`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
-          (cl-assert (eq (cadr mapping) fun))
-          `(,callsym ,fun
-                     ,@(mapcar (lambda (fv)
-                                 (let ((exp (or (cdr (assq fv env)) fv)))
-                                   (pcase exp
-                                     (`(car-safe ,iexp . ,_) iexp)
-                                     (_ exp))))
-                               fvs)
-                     ,@(mapcar (lambda (arg)
-                                 (cconv-convert arg env extend))
-                               args)))
-         (_ `(,callsym ,@(mapcar (lambda (arg)
+      (`(condition-case ,var ,protected-form . ,handlers)
+       (let* ((class (and var (cconv--var-classification (list var) form)))
+              (newenv
+               (cond ((eq class :captured+mutated)
+                      (cons `(,var . (car-safe ,var)) env))
+                     ((assq var env) (cons `(,var) env))
+                     (t env)))
+              (msg (when (eq class :unused)
+                     (cconv--warn-unused-msg var "variable")))
+              (newprotform (cconv-convert protected-form env extend)))
+         `(,(car form) ,var
+           ,(if msg
+                (macroexp--warn-wrap var msg newprotform 'lexical)
+              newprotform)
+           ,@(mapcar
+              (lambda (handler)
+                `(,(car handler)
+                  ,@(let ((body
+                           (mapcar (lambda (form)
+                                     (cconv-convert form newenv extend))
+                                   (cdr handler))))
+                      (if (not (eq class :captured+mutated))
+                          body
+                        `((let ((,var (list ,var))) ,@body))))))
+              handlers))))
+
+      (`(unwind-protect ,form1 . ,body)
+       `(,(car form) ,(cconv-convert form1 env extend)
+         :fun-body ,(cconv--convert-function () body env form1)))
+
+      (`(setq ,var ,expr)
+       (let ((var-new (or (cdr (assq var env)) var))
+             (value (cconv-convert expr env extend)))
+         (pcase var-new
+           ((pred symbolp) `(,(car form) ,var-new ,value))
+           (`(car-safe ,iexp) `(setcar ,iexp ,value))
+           ;; This "should never happen", but for variables which are
+           ;; mutated+captured+unused, we may end up trying to `setq'
+           ;; on a closed-over variable, so just drop the setq.
+           (_ ;; (byte-compile-report-error
+            ;;  (format "Internal error in cconv of (setq %s ..)"
+            ;;          sym-new))
+            value))))
+
+      (`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
+       ;; These are not special forms but we treat them separately for the 
needs
+       ;; of lambda lifting.
+       (let ((mapping (cdr (assq fun env))))
+         (pcase mapping
+           (`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
+            (cl-assert (eq (cadr mapping) fun))
+            `(,callsym ,fun
+                       ,@(mapcar (lambda (fv)
+                                   (let ((exp (or (cdr (assq fv env)) fv)))
+                                     (pcase exp
+                                       (`(car-safe ,iexp . ,_) iexp)
+                                       (_ exp))))
+                                 fvs)
+                       ,@(mapcar (lambda (arg)
                                    (cconv-convert arg env extend))
-                                 (cons fun args)))))))
-
-    ;; The form (if any) is converted beforehand as part of the `lambda' case.
-    (`(interactive . ,_) form)
-
-    ;; `declare' should now be macro-expanded away (and if they're not, we're
-    ;; in trouble because they *can* contain code nowadays).
-    ;; (`(declare . ,_) form)              ;The args don't contain code.
-
-    (`(oclosure--fix-type (ignore . ,vars) ,exp)
-     (dolist (var vars)
-       (let ((x (assq var env)))
-         (pcase (cdr x)
-           (`(car-safe . ,_) (error "Slot %S should not be mutated" var))
-           (_ (cl-assert (null (cdr x)))))))
-     (cconv-convert exp env extend))
-
-    (`(,func . ,forms)
-     (if (symbolp func)
-         ;; First element is function or whatever function-like forms are:
-         ;; or, and, if, catch, progn, prog1, while, until
-         `(,func . ,(mapcar (lambda (form)
-                              (cconv-convert form env extend))
-                            forms))
-       (byte-compile-warn-x form "Malformed function `%S'" func)
-       nil))
-
-    (_ (or (cdr (assq form env)) form)))))
+                                 args)))
+           (_ `(,callsym ,@(mapcar (lambda (arg)
+                                     (cconv-convert arg env extend))
+                                   (cons fun args)))))))
+
+      ;; The form (if any) is converted beforehand as part of the `lambda' 
case.
+      (`(interactive . ,_) form)
+
+      ;; `declare' should now be macro-expanded away (and if they're not, we're
+      ;; in trouble because they *can* contain code nowadays).
+      ;; (`(declare . ,_) form)              ;The args don't contain code.
+
+      (`(oclosure--fix-type (ignore . ,vars) ,exp)
+       (dolist (var vars)
+         (let ((x (assq var env)))
+           (pcase (cdr x)
+             (`(car-safe . ,_) (error "Slot %S should not be mutated" var))
+             (_ (cl-assert (null (cdr x)))))))
+       (cconv-convert exp env extend))
+
+      (`(,func . ,forms)
+       (if (symbolp func)
+           ;; First element is function or whatever function-like forms are:
+           ;; or, and, if, catch, progn, prog1, while, until
+           `(,func . ,(mapcar (lambda (form)
+                                (cconv-convert form env extend))
+                              forms))
+         (byte-compile-warn-x form "Malformed function `%S'" func)
+         nil))
+
+      (_ (or (cdr (assq form env)) form)))))
 
 (defvar byte-compile-lexical-variables)
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]