program lisp_in_pascal;
{Inputs list, parses list, binds atoms, and prints in list notation}
const
  max_hash = 1601;
type
  lis = array[1..100] of string;
  str40= string[40];
  str3= string[3];
  tagtype = (list, symbol);
  pointer = ^node;
  node = record
    case tag:tagtype of
      list : (left,right: pointer);
      symbol : (name : str40; value: integer; func,hashnext: pointer;intern:boolean);
  end;
  filtype = file of node;

var
  p : pointer;
  lista,listb :lis;
  strn : string;
  i : integer;
  hash:array [0..1600] of pointer;

function hashn(str:string):integer;
var
  x:integer;
begin
  x := 0;
  for i:=1 to length(str) do x := x + ord(str[i]);
  hashn := x mod max_hash;
end;
  
  function left(str:string):char;
  begin
    left := str[1];
  end;
  
  procedure bind(p:pointer);
  var
    q:pointer;
    d:boolean;
    h:integer;

  begin
    d := false;
    if p^.tag = list then
    begin
      bind(p^.left);
      bind(p^.right);
    end else begin
      if (left(p^.name) in ['a'..'z']) then
      begin
      if p^.name = 'nil' then p:=hash[0]
      else begin
        h := hashn(p^.name);
        q := hash[h];
        if q=hash[0] then 
        begin
          write('first $',p^.name,'$ ');
          p^.hashnext := hash[0];
          hash[h] := p;
        end else begin
        while q <> hash[0] do
        begin
          if q^.name = p^.name then
          begin
            write('old $',p^.name,' ',q^.name,'$ ');
            d := true;
            p := q;
            q := hash[0];
          end else q := q^.hashnext;
        end;
        if d=false then
        begin
          write('new $',q^.name,'$ ');
          q := p;
          q^.hashnext := hash[0];
        end;
        end;
      end;
      end;
    end;
  end;

function readi:pointer;
var
  point:pointer;

  function getstr:string;
  var
    str:string;
  begin
    readln(strn);
    getstr := strn;
  end;
  
  function right(str:string):string;
  begin
    right := str[length(str)];
  end;

  function tree(str:string):pointer;
  var
    temp:string;
    f,c,l,i,j:integer;
    po:pointer;

    procedure tr(p:pointer);
    begin
      l := l+1;
      if lista[l]='(' then
      begin
        p^.tag := list;
        new(p^.left);
        tr(p^.left);
        new(p^.right);
        tr(p^.right);
      end else
      if (lista[l]=')') or (lista[l]='') then
      begin
        p^.tag := symbol;
        p^.name := 'nil';
      end else
      begin
        p^.tag := list;
        new(p^.left);
        p^.left^.tag := symbol;
        p^.left^.name := lista[l];
        new(p^.right);
        tr(p^.right);
      end;
    end;

  begin
    for i := 1 to 100 do lista[i]:='';
    for i := 1 to 100 do listb[i]:='';
    c := 0;
    l := 1;
    for i:=1 to length(str) do
    begin
      if str[i] = ' ' then
      begin
        c := c + 1;
        for j:=l to i - 1 do lista[c] := lista[c] + str[j];
        l := i+1;
      end;
    end;
    if length(str)>=l then 
    begin
      c := c+1;
      for i := l to length(str) do lista[c] := lista[c] + str[i];
    end;
    l := 0;
    for i := 1 to c do
    begin
      l := l + 1;
      while (left(lista[i])='(') and (length(lista[i])>1) do
      begin
        listb[l] := '(';
        lista[i] := copy(lista[i],2,length(lista[i])-1);
        l := l + 1;
      end;
      f := 0;
      while (right(lista[i])=')') and (length(lista[i])>1) do
      begin
        f := f + 1;
        listb[l] := ')';
        lista[i] := copy(lista[i],1,length(lista[i])-1);
        l := l + 1;
      end;
      listb[l] := lista[i];
      if f>0 then
      begin
        temp := listb[l - f];
        listb[l - f] := listb[l];
        listb[l] := temp;
      end; 
    end;
    listb[l+1]:='';
    lista := listb;
    new(po);
    l := 0;
    tr(po);
    tree := po;
  end;

begin
  strn := getstr;
  point := tree(strn);
  bind(point);
  readi := point;
end;


procedure printdot(p:pointer);
begin       {prints in dot notation}
  if p^.tag = symbol then write(p^.name)
  else begin
    write('(');
    printdot(p^.left);
    write('.');
    printdot(p^.right);
    write(')');
  end;
end; 

procedure killtree(p:pointer);
begin
  if p^.tag = symbol then dispose(p)
  else begin
    killtree(p^.left);
    killtree(p^.right);
    dispose(p);
  end;
end;

procedure printlist(po:pointer);
var         {prints in list notation}
  la:string;
  
  procedure pl(p:pointer);
  begin      
    if p^.tag = symbol then 
    begin
      if (la <> '(') and (p^.name<>'nil') then write(' ');
      if p^.name<>'nil' then write(p^.name);
      la := p^.name;
    end
    else begin
      if p^.left^.tag = list then 
      begin
        if la <>'(' then write(' ');
        write('(');
        la := '(';
      end;
      pl(p^.left);
      if p^.left^.tag = list then 
      begin
        write(')');
        la := ')';
      end;
      pl(p^.right);
    end;
  end;

begin
  la := '(';
  pl(po);
  killtree(po);
end;


procedure eval(p:pointer);
var
  q:pointer;
  te:integer;
  s:str3;

procedure execin(p,q:pointer);
var
  st:string;

  procedure setq(p:pointer);
  begin
    eval(p^.right);
    val(p^.right^.name,p^.left^.value,i);
  end;

begin
  write('blah ');
  st := p^.name;
  if st='setq' then setq(q);
end;

begin
  if (p^.tag=list) and (p^.left^.tag=list) then eval(p^.left)
  else if p^.tag=list then
  begin
    write('blah2 ');
    q := p^.left;
    if q^.intern=true then execin(q,p^.right);
  end else str(p^.value,p^.name);
end;

procedure init;
var
  s:string[3];
begin
  new(p);
  p^.tag := symbol;
  p^.name := 'nil';
  for i:=0 to 1600 do hash[i] := p;
  bind(p);
  {p^.name := 'setq';
  p^.intern := true;
  bind(p);
  p^.name := 'xa';
  p^.intern := false;
  p^.value := 5;
  bind(p);}
end;

begin
  init;
  repeat  
  begin
    write(':');
    p := readi;
    {eval(p);}
    printlist(p);
    writeln('');
  end
  until strn='quit';
end.

