-- filename liststac.adb 2:17PM  9/1/95
-- The body of list.stacks defines those new primitives that are needed
-- for stacks. Push and Pop are different from cons and rest, since they
-- side effect their argument stacks.

package body list.stacks is

procedure MkEmpty(S:in out Stack) is
begin
     S := Empty;
end MkEmpty;

procedure push(x:in element; onStk:in out Stack) is
begin
     onStk := cons(x,onStk); 
exception
     when storage_error => raise overflow;
end push;

procedure pop(S: in out Stack) is
begin
     if S=Empty
     then raise Underflow;
     else S := Rest(S);
     end if;
end pop;

procedure Copy(S1: in Stack; S2: in out Stack) is
T : Stack;
begin
  if IsEmpty(S1)
     then S2 := S1;
     else Copy(Rest(S1), T);
	  S2 := cons(TopOf(S1), T);
  end if;
exception
  when storage_error => raise overflow;
end Copy;

procedure MkSame(S1: in Stack; S2: in out Stack) is
begin
     S2:=S1;
end MkSame;

function IsSame(S1,S2: in Stack) return Boolean is
begin
     return S1=S2;
end IsSame;

end list.stacks;