condense.red 487 B

12345678910111213141516171819202122232425
  1. module condense; % unify exponent vectors for lower memory consumption.
  2. % Author: Herbert Melenk
  3. fluid '(dipevlist!*);
  4. dipevlist!*:={nil};
  5. symbolic procedure dipcondense f;
  6. begin scalar dl,ev;
  7. dl:=dipevlist!*;
  8. while f do
  9. <<ev := dipevlmon f;
  10. while cdr dl and evcompless!?(dipevlmon f,cadr dl) do dl:=cdr dl;
  11. if cdr dl and ev=cadr dl
  12. then car f := cadr dl
  13. else cdr dl:= ev.cdr dl;
  14. f:=dipmred f;
  15. >>;
  16. end;
  17. endmodule;
  18. end;