Wrong! (%o2) should be -zzz
The fix is easy.
Logged In: YES
Looks like what happens is that signumrule1 gives up after simpsignum returns -1 * signum(x), because the operator in that result is not %SIGNUM:
#<FUNCTION LAMBDA (X ANS A3) (SETQ X (SIMPSIGNUM X ANS A3))
(COND (*AFTERFLAG X)
(PROG (TR-GENSYM~0 *AFTERFLAG RULE-HIT) (DECLARE (SPECIAL TR-GENSYM~0 *AFTERFLAG)) (SETQ *AFTERFLAG T)
(COND ((OR (ATOM X) (NOT (EQ (CAAR X) '%SIGNUM))) (RETURN X))) (SETQ TR-GENSYM~0 (CDR X))
(MULTIPLE-VALUE-SETQ (ANS RULE-HIT)
(PROG (TR-GENSYM~1) (DECLARE (SPECIAL TR-GENSYM~1)) (SETQ TR-GENSYM~1 (KAR TR-GENSYM~0))
(COND ((NOT (ALIKE1 TR-GENSYM~1 (MEVAL '$X))) (MATCHERR))) (COND ((NTHKDR TR-GENSYM~0 1) (MATCHERR))) (RETURN (VALUES (MEVAL '$ZZZ) T)))))
(RETURN (IF RULE-HIT ANS (EQTEST X X))))))>
I'm not sure what to do here. I guess if whichever simplification functions are carried out return an expression with a different operator, then maybe start over? I guess the problem to watch out for is endless looping. The *AFTERFLAG special variable is meant to prevent that; it might also prevent starting over from having any effect.
Logged In: YES
Here is a proposed fix (untested)
(defmfun simpsignum (x y z)
(setq y (simpcheck (cadr x) z))
(cond ((mnump y)
(setq y (num1 y)) (cond ((plusp y) 1) ((minusp y) -1) (t 0)))
((eq (setq z (csign y)) t) (eqtest (list '(%signum) y) x))
((eq z '$pos) 1)
((eq z '$neg) -1)
((eq z '$zero) 0)
((mminusp y) (neg (take '(%signum) (neg y))))
(t (eqtest (list '(%signum) y) x))))
I fixed a similar bug in simpabs. The problem is that (mul2 -1 (list
'(%signum simp) (neg y))) doesn't send the signum expression through
simplifya. In this code, if (mminpus y) and (mminusp (neg y)) are both
true, the code will infinitely loop.
Here is another (untested) fix. As a bonus, it does signum(signum(x))
--> signum(x). It uses the apply-reflection-rule scheme instead of
I don't see the point of the (mnump y) check in the original code
(speed maybe) -- csign should take care of this. I also cut the eqtest
stuff. Maybe that's not good--I don't know.
(setf (get '%signum 'reflection-rule) #'odd-function-reflect)
(defun simpsignum (x yy z)
(declare (ignore yy))
(setq x (simpcheck (cadr x) z))
(let ((sgn (csign x)))
(cond ((eq sgn '$pos) 1)
((eq sgn '$neg) -1)
((eq sgn '$zero) 0)
((op-equalp x '%signum) x)
((apply-reflection-simp '%signum x t))
(t `((%signum simp) ,x)))))
Barton, I see what you mean, makes sense to me. I think you should go ahead and try the proposed fix. Let us know how it turns out.
Applied proposed fix -- testsuite is OK.
Log in to post a comment.
Sign up for the SourceForge newsletter:
You seem to have CSS turned off.
Please don't fill out this field.