unit list;

interface

type
  ptlist = ^tlist;
  ttype = integer;

  ptitem = ^titem;
  titem = object
    info: ttype;
    next: ptitem;
    sublist: ptlist;

    constructor init(x: ttype; a_next: ptitem; a_sublist: ptlist);
    destructor done;
  end;

  tlist = object
    first, last: ptitem;

    constructor init;
    destructor done;

    procedure invert;

    procedure append(x: ttype);
    procedure insert(x: ttype);

    function present(x: ttype): boolean;
    function find(x: ttype): ptitem;
    function remove(x: ttype): integer;

    procedure insert_before(p: ptitem;
              x: ttype);
    procedure insert_after(p: ptitem;
              x: ttype);

    function empty: boolean;
    procedure print;
  private
    procedure remove_item(p: ptitem);
  end;


implementation

constructor titem.init(x: ttype; a_next: ptitem; a_sublist: ptlist);
begin
  info := x;
  next := a_next;
  sublist := a_sublist;
end;

destructor titem.done;
begin
end;


constructor tlist.init;
begin
  first := nil; last := nil;
end;
destructor tlist.done;
var p, T: ptitem;
begin
  p := first;
  while assigned(p) do begin
    T := p;
    p := p^.next;
    dispose(T, done)
  end;
end;

function tlist.empty: boolean;
begin
  empty := not assigned(first)
end;

{
  insert new item to the start of list
}
procedure tlist.insert(x: ttype);
var p: ptitem;
begin
  new(p, init(x, first, nil));
  if empty then last := p;
  first := p
end;

{
  append new item to the end of list
}
procedure tlist.append(x: ttype);
var p: ptitem;
begin
  new(p, init(x, nil, nil));
  if empty then first := p
  else last^.next := p;
  last := p
end;


procedure tlist.print;
var p: ptitem;
begin
  p := first;
  write('(list) <');
  while assigned(p) do begin
    write(p^.info, ' ');

    if p^.sublist <> nil then begin
      write('(');
      p^.sublist^.print;
      write(')');
    end;

    p := p^.next
  end;
  writeln('>')
end;

procedure tlist.invert;
var p, T: ptitem;
begin
  if empty or (not assigned(first^.next)) then exit
  else begin
    p := nil; last := first;
    while assigned(first) do begin

      if first^.sublist <> nil then begin
        first^.sublist^.invert;
      end;

      T := first^.next;
      first^.next := p;
      p := first;
      first := T
    end;
    first := p
  end
end;

procedure tlist.insert_before(p: ptitem;
          x: ttype);
var T: ptitem;
begin
  new(T, init(p^.info, p^.next, nil));
  p^.next := T;
  p^.info := x
end;
procedure tlist.insert_after(p: ptitem;
          x: ttype);
var T: ptitem;
begin
  new(T, init(x, p^.next, nil));
  p^.next := T
end;

function tlist.find(x: ttype): ptitem;
var
  p: ptitem;
  ok: boolean;
begin
  p := first;
  ok := true;
  while assigned(p) and ok do
    if p^.info = x then ok := false
    else p := p^.next;

  find := p
end;

function tlist.present(x: ttype): boolean;
begin
  present := (find(x) <> nil)
end;


function tlist.remove(x: ttype): integer;
var
  T: ptitem;
  count: integer;
begin
  count := 0;
  repeat
    T := find(x);
    if assigned(T) then begin
      remove_item(T);
      inc(count)
    end
  until (T = nil);
  remove := count
end;

procedure tlist.remove_item(p: ptitem);
var r: ptitem;
begin
  r := p^.next;
  p^ := r^;
  dispose(r, done);
  r := nil
end;

end.