[Axiom-developer] #196 ')set functions compile on'

[Vanuxem Grégory]

Hi Tim,


I'm working on the issue #196 and i have found the code responsible of
this bug. The problem is the expansion of macro. The code is (in
src/inter/macros.lisp.pamphlet):

====================================================================
(defun eval-defun (name body) (eval (macroexpandall body)))

(defun macroexpandall (sexpr)
(cond
  ((atom sexpr) sexpr)
  ((eq (car sexpr) 'quote) sexpr)
  ((eq (car sexpr) 'defun)
   (cons (car sexpr) (cons (cadr sexpr)
       (mapcar #'macroexpandall (cddr sexpr)))))
  ((and (symbolp (car sexpr)) (macro-function (car sexpr)))
   (do ()
       ((not (and (consp sexpr) (symbolp (car sexpr))
  (macro-function (car sexpr)))))
     (setq sexpr (macroexpand sexpr)))
   (if (consp sexpr)
       ; infinite loop generated on lambda expression
       (mapcar #'macroexpandall sexpr)
       sexpr))
  ('else 
    (mapcar #'macroexpandall sexpr))))
=====================================================================

The problem is apparently the expansion of lambda expression.
macroexpandall expands (lambda *) to (function (lambda) *) and reexpands
it causing an infinite loop and therefore a value stack overflow and on
older version of Axiom a segmentation fault.

I use the following dirty hack but since i'm not a good lisp programmer
and you are, as you said, a lisp programmer maybe you can find a better
solution:

=====================================================================
(defun macroexpandall (sexpr)
(cond
  ((atom sexpr) sexpr)
  ((eq (car sexpr) 'quote) sexpr)
  ((eq (car sexpr) 'defun)
   (cons (car sexpr) (cons (cadr sexpr)
       (mapcar #'macroexpandall (cddr sexpr)))))
  ((and (symbolp (car sexpr)) (macro-function (car sexpr)))
   (do ()
       ((not (and (consp sexpr) (symbolp (car sexpr))
                  (macro-function (car sexpr)))))
     (setq sexpr (macroexpand sexpr)))
   (if (consp sexpr)
       (let ((a (car sexpr)) (b (caadr sexpr))) 
         (if (and (eq a 'function) (eq b 'lambda))
           (cons a (list (cons b (mapcar #'macroexpandall (cdadr
sexpr)))))
           (mapcar #'macroexpandall sexpr)))
       sexpr))
  ('else        
    (mapcar #'macroexpandall sexpr))))
======================================================================


If you can loot at this, when time permits of course.


PS: If you write a patch, can you send me the new code ?
    If this bug is fixed we can close issues #196 and #114 




Some notes:

=================================================================
Environment:

)tr  genMapCode 
)tr mkInterpFun
)tr compileDeclaredMap
)tr reportFunctionCompilation 
)tr compileInteractive 
)tr COMP
)tr COMP_-1
)tr COMP_-2 
--)tr COMP_-SPADSLAM 
--)tr COMP_-ILAM 
--)tr compClam 
--)tr MOAN 
--)tr COMP_-SLAM 
)tr COMP370 
--)tr COMPILE


-- standard-output redirection and 
-- *comp370-apply* affectation ('eval-defun')
)tr compQuietly  

-- funcall *comp370-apply*
)lisp (trace VMLISP::COMPILE1)

=================================================================


Some code that triggers this bug and the corresponded macroexpandall
argument:

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

)set func comp off
f(xl: LIST FRAC INT): LIST FRAC INT == map(x +-> x, xl)
f [1,2,3]

(DEFUN |*1;f;1;initial| (|#1| |envArg|) (PROG (#:G1420) (RETURN (PROGN
(LETT #:G1420 (QUOTE UNINITIALIZED_VARIABLE) |f| |*1;f;1;initial|)
(SPADCALL (CONS (|function| (LAMBDA (#:G1420 |envArg|) #:G1420))
(VECTOR)) |#1| (QREFELT |*1;f;1;initial;MV| 0))))))

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

)set func comp off
CurryR(f:(INT,INT)->INT):INT->(INT->INT) ==
(x:INT):(INT->INT)+->curryRight(f,x)
p:=CurryR(+)

(DEFUN |*1;CurryR;1;initial| (|#1| |envArg|) (PROG (#:G1420) (RETURN
(PROGN (LETT #:G1420 (QUOTE UNINITIALIZED_VARIABLE) |CurryR| |
*1;CurryR;1;initial|) (CONS (|function| (LAMBDA (#:G1420 |envArg|)
(SPADCALL (ELT |envArg| 0) #:G1420 (QREFELT |
*1;anonymousFunction;0;initial;internal;MV| 0)))) (VECTOR |#1|))))))


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

)set func comp off
j:=120
nume(a) == cons(1 :: Float,[((a-i)*i) :: Float for i in 1..]);
dene(a,x) == [(x+2*i+1-a) :: Float for i in 0..];
cfe(a,x) == continuedFraction(0,nume(a),dene(a,x));
ccfe(a,x) == convergents cfe(a,x);
gamcfe(a,x) == exp(-x)*x^a*ccfe(a,x).j;
gamcfe(2,3)

(DEFUN |*1;nume;1;initial| (|#1| |envArg|) (PROG (|i|) (RETURN (PROGN
(LETT |i| (QUOTE UNINITIALIZED_VARIABLE) |nume| |*1;nume;1;initial|)
(SPADCALL (QUOTE (1 . 0)) (SPADCALL (CONS (|function| (LAMBDA (|i| |
envArg|) (|failCheck| (SPADCALL (SPADCALL (SPADCALL (ELT |envArg| 0) |i|
(QREFELT |*1;nume;1;initial;MV| 5)) |i| (QREFELT |*1;nume;1;initial;MV|
6)) (QREFELT |*1;nume;1;initial;MV| 7))))) (VECTOR |#1|)) (SPADCALL
(SPADCALL (SPADCALL (SPADCALL 1 (QREFELT |*1;nume;1;initial;MV| 0))
(QREFELT |*1;nume;1;initial;MV| 2)) (QREFELT |*1;nume;1;initial;MV| 3))
(SPADCALL (SPADCALL 1 (QREFELT |*1;nume;1;initial;MV| 0)) (QREFELT |
*1;nume;1;initial;MV| 1)) (QREFELT |*1;nume;1;initial;MV| 4)) (QREFELT |
*1;nume;1;initial;MV| 8)) (QREFELT |*1;nume;1;initial;MV| 9))))))


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