mini-cons-mkvect.red 729 B

12345678910111213141516171819202122232425262728293031323334353637383940
  1. % MINI-CONS.RED : Cons, MkVect etc for testing
  2. %/Almost identical to PK:CONS-MKVECT
  3. on syslisp;
  4. procedure HardCons(x,y);
  5. Begin scalar c;
  6. c:=GtHeap PairPack();
  7. c[0]:=x;
  8. c[1]:=y;
  9. Return MkPAIR(c);
  10. End;
  11. procedure Cons(x,y);
  12. HardCons(x,y);
  13. procedure Xcons(x,y);
  14. HardCons(y,x);
  15. procedure Ncons x;
  16. HardCons(x,'NIL);
  17. syslsp procedure MkVect N;
  18. % Allocate vector, init all to NIL
  19. if IntP N then
  20. << N := IntInf N;
  21. if N < (-1) then
  22. StdError
  23. '"A vector with fewer than zero elements cannot be allocated"
  24. else begin scalar V;
  25. V := GtVect N;
  26. for I := 0 step 1 until N do VecItm(V, I) := NIL;
  27. return MkVEC V; % Tag it
  28. end >>
  29. else NonIntegerError(N, 'MkVect);
  30. off syslisp;
  31. End;