where.red 836 B

12345678910111213141516171819202122232425262728293031
  1. module where; % Support for a where construct.
  2. % Author: Anthony C. Hearn.
  3. % Copyright (c) 1987 The RAND Corporation. All rights reserved.
  4. % global '(fixedpreclis!*);
  5. symbolic procedure formwhere(u,vars,mode);
  6. begin scalar expn,equivs,y,z;
  7. expn := cadr u;
  8. equivs := remcomma caddr u;
  9. if not(mode eq 'symbolic)
  10. then return formc(list('whereexp,'list . equivs,expn),vars,mode);
  11. for each j in equivs do
  12. if not atom j and car j memq '(equal setq)
  13. then <<y := caddr j . y; z := cadr j . z>>
  14. else rerror(rlisp,17,list(j,"invalid in WHERE statement"));
  15. return formc(list('lambda,reversip z,expn) . reversip y,vars,mode)
  16. end;
  17. put('where,'formfn,'formwhere);
  18. % fixedpreclis!* := 'where . fixedpreclis!*; % Where has special place.
  19. % mkprec();
  20. endmodule;
  21. end;