{$c moveable demandload discardable}
Program calculator;

type
  kindtype = (num, sym, opp);
  str10 = string[10];
  str5 = string[5];
  list = array [1..255] of str10;
  node = ^Pnode;
  Pnode = record
    nam:str5;
    case kind:kindtype of
      num:(val:integer);
{           neg:boolean}
{      sym:(nam:str5);}
      opp:({nam:str5;}
           lt,rt:node);
    end;
  Stable = array [1..1000,1..2] of node;
  ifftab = array [1..1000] of boolean;

var
  show,emul,ediv:boolean;
  max,max2:integer;
  table:Stable;
  iff:ifftab;
  swi:ifftab;
  last:string;

  procedure lis(s:string;var ar:list); forward;
  procedure parse(var li:list;var l:integer;var n:node); forward;

  procedure new_node(var n:node;k:kindtype);
  begin
    new(n);
    n^.kind:=k;
    if k=num then
    begin
      n^.val:=0;
{      n^.neg:=false;}
    end else if k=sym then
      n^.nam:=''
    else begin
      n^.nam:='';
      n^.lt:=nil;
      n^.rt:=nil;
    end;
  end;

  procedure disp_str(n:node;var s:string);
  var t:string;
  begin
    if n=nil then s:=s+'_';
    if n<>nil then
    begin
{      if (n^.kind=sym) and n^.neg then s:=s+'-');}
      if n^.kind = num then
      begin
        str(n^.val,t);
        s:=s+t;
      end
      else if n^.kind = sym then s:=s+n^.nam
      else begin
        if n^.lt=nil then
        begin
          s:=s+'_'+n^.nam;
          disp_str(n^.rt,s);
        end else begin
          s:=s+'(';
          disp_str(n^.lt,s);
          s:=s+n^.nam;
          disp_str(n^.rt,s);
          s:=s+')';
        end;
      end;
    end;
  end;

  procedure save;
  var
    s:string;
    i,j:integer;
    f:text;
  begin
    write('Enter filename: ');
    readln(s);
    assign(f,s);
    rewrite(f);
    for i:=1 to max do
    begin
      s:='';
      disp_str(table[i,1],s);
      writeln(f,s);
      s:='';
      disp_str(table[i,2],s);
      writeln(f,s);
      if iff[i] then writeln(f,1) else writeln(f,0);
    end;
    close(f);
  end;

  procedure load;
  var
    s:string;
    i,j:integer;
    f:text;
    l:list;
    a:integer;
    n:node;
  begin
    write('Enter filename: ');
    readln(s);
    assign(f,s);
    reset(f);
    while not eof(f) do
    begin
      max:=max+1;
      s:='';
      while s='' do readln(f,s);
      a:=0;
      lis(s,l);
      parse(l,a,n);
      table[max,1]:=n;
      readln(f,s);
      a:=0;
      lis(s,l);
      parse(l,a,n);
      table[max,2]:=n;
      a:=0;
      readln(f,a);
      if a=0 then iff[max]:=false else iff[max]:=true;
    end;
    close(f);
  end;

  procedure kil(var n:node);
  begin
    if n<>nil then
    begin
     if n^.kind=opp then
     begin
       kil(n^.lt);
       kil(n^.rt);
     end;
     dispose(n);
    end;
  end;

  procedure remove_func;
  var
    n,i:integer;
  begin
    write('Enter func number: ');
    readln(n);
    if n<=max then
    begin
      kil(table[n,1]);
      kil(table[n,2]);
      for i:=n to max-1 do
      begin
        table[i,1]:=table[i+1,1];
        table[i,2]:=table[i+1,2];
        iff[i]:=iff[i+1];
        swi[i]:=swi[i+1];
      end;
      max:=max-1;
    end;
  end;

  function valu(str:str10):integer;
  var
    i:integer;
    a:real;
  begin
    val(str,a,i);
    valu:=trunc(a);
  end;

  procedure disp(n:node);
  begin
    if n=nil then write('_');
    if n<>nil then
    begin
{      if (n^.kind=sym) and n^.neg then write('-');}
      if n^.kind = num then write(n^.val)
      else if n^.kind = sym then write(n^.nam)
      else begin
        if n^.lt=nil then
        begin
          write('_',n^.nam);
          disp(n^.rt);
        end else begin
          write('(');
          disp(n^.lt);
          write(n^.nam);
          disp(n^.rt);
          write(')');
        end;
      end;
    end;
  end;

  procedure factor(var a:node);
  var
    i,m:integer;
    n:real;
    temp:node;
  begin
    if a^.kind = num then
    begin
      temp:=a;
      if a^.val = trunc(a^.val) then
      begin
        n:=a^.val;
        m:=trunc(n/2);
        for i:=2 to trunc(n-1) do
        begin
          if n/i>1 then
            if n/i = trunc(n/i) then
            begin
              disp(temp);
              a^.kind:=opp;
              a^.nam:='*';
              new_node(a^.lt,num);
              new_node(a^.rt,num);
              a^.lt^.val:=i;
              n:=n/i;
              a^.rt^.val:=trunc(n);
              a:=a^.rt;
              i:=1;
              writeln;
              disp(temp);
              writeln;
            end;
        end;
      end;
      a:=temp;
    end;
  end;

  function equal(n,m:node):boolean;
  var
    e:boolean;
  begin
    e:=(n=nil) and (m=nil);
    if (n<>nil) and (m<>nil) then
    begin
      if n^.kind = m^.kind then
      begin
        if n^.kind = opp then
        begin
          if n^.nam[1] in ['*','+'] then
            e:= (equal(n^.lt,m^.lt) and equal(n^.rt,m^.rt))
              or (equal(n^.lt,m^.rt) and equal(n^.rt,m^.lt))
            else e:=equal(n^.lt,m^.lt) and equal(n^.rt,m^.rt);
        end;
        case n^.kind of
          sym:e:=m^.nam = n^.nam;
          opp:e:=e and (m^.nam = n^.nam);
          num:e:=m^.val=n^.val;
        end;
      end;
    end;
    equal:=e;
  end;

  procedure inpu(var n:node); forward;

  procedure lis(s:string;var ar:list);
  var
    i,c,l:integer;
  begin
    c:=1;
    l:=1;
    for i:=1 to 255 do ar[i]:= '';
    while l<length(s)+1 do
    begin
      case s[l] of
      'a'..'z','0'..'9':begin
        while ((s[l] in ['a'..'z']) or (s[l] in ['0'..'9'])) and (l<length(s)+1) do
        begin
          ar[c]:= ar[c]+s[l];
          l:=l+1;
        end;
        c:=c+1;
        l:=l-1;
      end;
      ' ',')':;{c:=c+1;}
      '_','(':begin
        ar[c]:=s[l];
        c:=c+1;
      end;
      else
        while not (s[l] in ['a'..'z','0'..'9',' ',')','_','(']) do
        begin
          ar[c]:=ar[c]+s[l];
          l:=l+1;
        end;
        c:=c+1;
        l:=l-1;
      end;
      l:=l+1;
    end;
  end;

  function right(s:string):string;
  var
    i:integer;
    sb:string;
  begin
    sb:='';
    for i:=2 to length(s) do sb:=sb+s[i];
    right:=sb;
  end;

  procedure parse(var li:list;var l:integer;var n:node);
  var z,jj:integer;
  begin
    z:=1;
    l:=l+1;
    case li[l][z] of
      'a'..'z':begin
        new_node(n,sym);
        n^.nam:=li[l];
      end;
      '0'..'9':begin
        new_node(n,num);
        n^.val:=valu(li[l]);
      end;
      '(','_':begin
        new_node(n,opp);
        if li[l][z]='(' then parse(li,l,n^.lt);
        parse(li,l,n);
        parse(li,l,n^.rt);
      end;
     else n^.nam:=li[l];
  end;
  end;

  procedure addeq;
  var
    a,b:node;
    n:integer;
  begin
    write('a-');
    inpu(a);
    write('b-');
    inpu(b);
    write('iff-');
    readln(n);
    max:=max+1;
    table[max,1]:= a;
    table[max,2]:= b;
    iff[max]:=not(n=0);
  end;

  procedure showeq;
  var i:integer;
  begin
    for i:=1 to max do
    begin
      write(i,' ');
      if iff[i] then write('iff ') else write('if ');
      disp(table[i,1]);
      write(' then ');
      disp(table[i,2]);
      writeln;
    end;
  end;

  procedure inpu(var n:node);
  var
    s:string;
    l:list;
    a:integer;
  label again;
  begin
    a:=0;
again:    write(':');
    readln(s);
    if s='quit' then halt;
    if s='last' then s:=last;
    if s='showeq' then
    begin
      showeq;
      goto again;
    end else
      if s='addeq' then
      begin
        addeq;
        goto again;
      end else if s='save' then
      begin
        save;
        goto again;
      end else if s='load' then
      begin
        load;
        goto again;
      end else if s='deleq' then
      begin
        remove_func;
        goto again;
      end else begin
        lis(s,l);
        parse(l,a,n);
      end;
  end;

  procedure init;
  var i:integer;
  begin
    max:=0;
    for i:=1 to 100 do
    begin
      table[i,1]:=nil;
      table[i,2]:=nil;
      iff[i]:=false;
      swi[i]:=false;
    end;
  end;

  procedure copyE(var a,b:node);
  begin
    if b=nil then a:=nil else
    begin
      new_node(a,b^.kind);
      case b^.kind of
        sym:a^.nam:=b^.nam;
        num:a^.val:=b^.val;
        opp:begin copyE(a^.lt,b^.lt); copyE(a^.rt,b^.rt); a^.nam:=b^.nam; end;
      end;
    end;
  end;

  procedure debind(var a:node;var T:Stable);
  var i:integer;
  begin
    if a<>nil then
    begin
      if a^.kind=sym then
        for i:=1 to max2 do
          if a^.nam=t[i,1]^.nam then begin
            kil(a);
            a:=T[i,2];
            i:=max2;
          end else
      else if a^.kind=opp then
      begin
        debind(a^.lt,T);
        debind(a^.rt,T);
      end;
    end;
  end;

  procedure resettab(var T:Stable);
  var i:integer;
  begin
    for i:=1 to max2 do
    begin
      kil(T[i,1]);
      kil(T[i,2]);
    end;
    max2:=0;
  end;

  function bind(a,b:node;var T:Stable):boolean;
  var
    c,d:boolean;
    i:integer;
  begin
    c:=false;
    d:=false;
    for i:=1 to max2 do
      if (T[i,1]^.nam=a^.nam) and (not d) then
      begin
        c:=equal(T[i,2],b);
        d:=true;
      end;
    if not d then
    begin
      max2:=max2+1;
      new_node(T[max2,1],sym);
      T[max2,1]^.nam:=a^.nam;
      copyE(T[max2,2],b);
      c:=true;
    end;
    bind:=c;
  end;

  function fit(a,b:node;var T:Stable):boolean;
  var
    f:boolean;
  begin
    f:=false;
    if a=nil then f:=(b=nil)
    else begin
      if a^.kind=b^.kind then
        begin
          if a^.kind=num then f:=(a^.val=b^.val);
          if (a^.kind=sym) or (a^.kind=opp) then f:=(a^.nam=b^.nam);
        end;
      if a^.kind=sym then f:=bind(a,b,T)
      else if a^.kind=opp then f:=f and (fit(a^.lt,b^.lt,T) and fit(a^.rt,b^.rt,T));
    end;
    fit:=f;
  end;

  procedure simp(var n:node);
  var
    a:node;
    i:integer;
    T:Stable;
  begin
    max2:=0;
    a:=nil;
    if (n<>nil) and (max>0) then
    begin
      for i:=1 to max do
        if fit(table[i,1],n,T) then
        begin
          write('fits- ');disp(table[i,1]);writeln;
          kil(n);
          copyE(n,table[i,2]);
          write('S1- ');disp(n);writeln;
          debind(n,T);
          write('S2- ');disp(n);writeln;
          copyE(a,n);
          resettab(T);
          n:=a;
          if iff[i] then swi[i]:=not swi[i];
{          i:=max;}
        end;
    end;
    if (max2>0) and (a<>nil) then
    begin
      n:=a;
      resettab(T);
    end;
  end;

  procedure switch2;
  var
    tem:node;
    i:integer;
  begin
    for i:=1 to max do
    begin
      if iff[i] then
      begin
        tem:=table[i,1];
        table[i,1]:=table[i,2];
        table[i,2]:=tem;
      end;
    end;
  end;

  procedure switch;
  var
    tem:node;
    i:integer;
  begin
    for i:=1 to max do
    begin
      if swi[i] then
      begin
        tem:=table[i,1];
        table[i,1]:=table[i,2];
        table[i,2]:=tem;
        swi[i]:=false;
      end;
    end;
  end;

  procedure basic(var n:node);
  var
    tem:node;
  begin
    case (n^.nam)[1] of
      '+':begin
        new_node(tem,num);
        tem^.val:=n^.lt^.val+n^.rt^.val;
        kil(n);
        n:=tem;
      end;
      '*':begin
        new_node(tem,num);
        tem^.val:=n^.lt^.val*n^.rt^.val;
        kil(n);
        n:=tem;
      end;
      '-':begin
        new_node(tem,num);
        tem^.val:= -1*n^.rt^.val;
        kil(n);
        n:=tem;
      end;
    end;
  end;

  procedure sim(var n:node);
  begin
    if n<>nil then
    begin
      if n^.kind=opp then
      begin
        if ((n^.lt^.kind=num) or (n^.lt=nil)) and (n^.rt^.kind=num) then basic(n);
        simp(n);
      end;
      if n^.kind=num then
        factor(n);
      if n^.kind=opp then
      begin
        sim(n^.lt);
        sim(n^.rt);
      end;
    end;
  end;

  procedure main;
  var
    a,b:node;
    Ne,i:integer;
  begin
    init;
    for i:=1 to 1000 do
    begin
      inpu(a);
      disp(a);
      writeln;
      sim(a);
      switch;
      switch2;
      disp(a);
      disp_str(a,last);
      writeln;
      kil(a);
    end;
  end;

begin
  main;
end.
