[ clisp-Bugs-1575946 ] broken COMPILE of APPLY in LABELS

[SourceForge.net <no...@so...>]

Bugs item #1575946, was opened at 2006-10-12 10:25
Message generated for change (Comment added) made by sds
You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=101355&aid=1575946&group_id=1355

Please note that this message will contain a full copy of the comment thread,
including the initial issue submission, for this request,
not just the latest update.
Category: clisp
Group: lisp error
Status: Open
Resolution: None
Priority: 5
Submitted By: Troels Henriksen (athas)
Assigned to: Bruno Haible (haible)
>Summary: broken COMPILE of APPLY in LABELS

Initial Comment:
When I attempt to evaluate the following code (which is
valid ANSI Common Lisp AFAIK, and which works in other
implementations I have tested), CLISP signals an error:

(progn (defun f ()
         (labels ((foo () (apply #'bar nil))
                  (bar ())))) 
       (compile 'f))

The error signalled is "SYSTEM::%STRUCTURE-REF: NIL is
not a structure of type SYSTEM::FNODE" (translated from
the Danish message). If the APPLY form is replaced with
the equivalent FUNCALL, no error is signalled.
Likewise, if you swap the order of appearance for the
definitions of FOO and BAR, no error is signalled. I
have experienced this on CLISP 2.38.

----------------------------------------------------------------------

>Comment By: Sam Steingold (sds)
Date: 2006-10-12 15:57

Message:
Logged In: YES 
user_id=5735

please try this patch:


--- compiler.lisp	27 Sep 2006 20:01:15 -0400	1.293
+++ compiler.lisp	12 Oct 2006 15:56:25 -0400	
@@ -6488,13 +6488,24 @@
           (multiple-value-bind (a m f1 f2 f3) (fenv-search fun)
             (declare (ignore m f1 f2))
             (if a           ; fun is local
+              (let ((fnode (car f3)))
+                (if fnode       ; valid entry
               (setq name fun
-                    req (fnode-req-anz (car f3))
-                    opt (fnode-opt-anz (car f3))
-                    rest-p (fnode-rest-flag (car f3))
-                    key-p (fnode-keyword-flag (car f3))
-                    keylist (fnode-keywords (car f3))
-                    allow-p (fnode-allow-other-keys-flag
(car f3)))
+                        req (fnode-req-anz fnode)
+                        opt (fnode-opt-anz fnode)
+                        rest-p (fnode-rest-flag fnode)
+                        key-p (fnode-keyword-flag fnode)
+                        keylist (fnode-keywords fnode)
+                        allow-p
(fnode-allow-other-keys-flag fnode))
+                  (setq name fun ; labels: no fnode yet
+                        ;; (cddr f3) are the return values of
+                        ;; C-ANALYZE-LAMBDALIST, see c-LABELS
+                        req (length (third f3))
+                        opt (length (fourth f3))
+                        rest-p (symbolp (seventh f3))
+                        key-p (eighth f3)
+                        keylist (ninth f3)
+                        allow-p (nth 12 f3))))
               (multiple-value-setq (name req opt rest-p
key-p keylist allow-p)
                 (function-signature fun t))) ; global
functions only
             (if (and name (equal fun name))


----------------------------------------------------------------------

You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=101355&aid=1575946&group_id=1355