PROGRAM Analysator(input,output);


LABEL 99,Loop;

CONST
  e  = 2.718281828;
  pi = 3.141592653589;

TYPE
  typ = (variable,operator,literal,funktion);
  atyp = real;

  p = ^node;
  node = RECORD
           t:typ;
           name:char;
           op1,op2:p;
           value:atyp
         END;

VAR f:              ARRAY['f'..'h',0..99] OF p;
    x,y,hi,lo,step: atyp;
    v:              ARRAY['a'..'d',0..99] OF atyp;
    c,c1:           char;
    i:              integer;
    fx:             p;
    prt,b,everr:    boolean;
    pr:             text;
    filename:       String[30];

Function Pri(b:p):integer;
  Begin
    Case b^.t Of
      operator: Case b^.name Of
                '+','-': Pri:=1;
                '*','/': Pri:=2;
                '^':     Pri:=3
                End;
      funktion: Pri:=4;
      variable,literal: Pri:=5
    End
  End;

Procedure WriteFunkName(Var tx:text; n:char);
  Begin
    Case n Of
      '-': write(tx,'-');
      '+': write(tx,'abs');
      'c': write(tx,'cos');
      'e': write(tx,'exp');
      'g': write(tx,'lg');
      'l': write(tx,'ln');
      'o': write(tx,'cot');
      'q': write(tx,'sqr');
      'r': write(tx,'sqrt');
      's': write(tx,'sin');
      't': write(tx,'tan');
      'v': write(tx,'sgn');
      'C': write(tx,'arccos');
      'O': write(tx,'arccot');
      'S': write(tx,'arcsin');
      'T': write(tx,'arctan');
    End
  End;

Procedure InFix(Var tx:text; b:p; pr:integer);
  Var ap:integer;
  Begin
    If b<>Nil Then
    Case b^.t Of
      variable: Begin
                  write(tx,b^.name); If b^.name='p' Then write(tx,'i')
                End;
      operator: Begin
                  ap:=pri(b);
                  If ap<pr Then write(tx,'(');
                  InFix(tx,b^.op1,ap);
                  write(tx,b^.name); InFix(tx,b^.op2,ap+1);
                  If ap<pr Then write(tx,')')
                End;
      literal: write(tx,b^.value,' ');
      Funktion: Begin
                  WriteFunkName(tx,b^.name);
                  If (pri(b^.op1)>=4) And (b^.name<>'-') Then write(tx,' ');
                  InFix(tx,b^.op1,4)
                End
    End
  End;

FUNCTION sgn(x:real):integer;
  BEGIN
    sgn:=ord(x>0)-ord(x<0)
  END;

Function eval(b:p; x:atyp):atyp;
  Var f,e1,e2:atyp;

  PROCEDURE Fehler;
    BEGIN
      everr:=true
    END;

  Begin
    case b^.t Of
      Variable:Case b^.name Of
                 'x': eval:=x;
                 'e': eval:=e;
                 'p': eval:=pi
               End;
      literal: eval:=b^.value;
      operator: BEGIN e1:=eval(b^.op1,x); e2:=eval(b^.op2,x);
                  Case b^.name Of
                  '+': eval:=e1+e2;
                  '-': eval:=e1-e2;
                  '*': eval:=e1*e2;
                  '/': IF e2=0 THEN Fehler ELSE
                       eval:=e1/e2;
                  '^': IF e2=0 THEN eval:=1
                       ELSE IF e2=1 THEN eval:=e1
                       ELSE IF e2=-1 THEN
                         IF e1=0 THEN Fehler ELSE eval:=1/e1
                       ELSE eval:=exp(ln(eval(b^.op1,x))*eval(b^.op2,x))
                  END
                End;
      funktion: Begin f:=eval(b^.op1,x);
                  Case b^.name Of
                    '-': eval:=-f;
                    '+': eval:=abs(f);
                    'c': eval:=cos(f);
                    'e': eval:=exp(f);
                    'g': eval:=ln(f)/ln(10);
                    'l': IF f<=0 THEN Fehler ELSE
                         eval:=ln(f);
                    'o': BEGIN e1:=sin(f);
                           IF e1=0 THEN Fehler
                           ELSE eval:=cos(f)/e1
                         END;
                    'q': eval:=sqr(f);
                    'r': IF f<0 THEN Fehler ELSE
                         eval:=sqrt(f);
                    's': eval:=sin(f);
                    't': BEGIN e1:=cos(f);
                           IF e1=0 THEN Fehler
                           ELSE
                             eval:=sin(f)/e1
                         END;
                    'v': eval:=round(ord(f>0)-ord(f<0));
                    'T': eval:=arctan(f);
                    'O': IF f=0 THEN Fehler ELSE
                         eval:=arctan(1/f)
                  End
                End
    End
  End;


Procedure Forget(Var z:p);
  Begin
    If z<>Nil Then
      Begin
        Forget(z^.op1);
        Forget(z^.op2);
        dispose(z);
        z:=Nil
      End
  End;


Function konstant(b:p):boolean;
  Begin
    If b=Nil Then konstant:=true
    Else
      Case b^.t Of
        variable: konstant:=b^.name<>'x';
        operator: konstant:=konstant(b^.op1) And konstant(b^.op2);
        literal:  konstant:=true;
        funktion: konstant:=konstant(b^.op1)
      End
  End;

Procedure Optimize(Var b:p);
  Var h:p;
  Begin
    If b<>Nil Then
      Begin
        Optimize(b^.op1); Optimize(b^.op2);
        If konstant(b) Then
          Begin
            New(h);
            With h^ Do
              Begin
                t:=literal;
                name:=' ';
                op1:=Nil;
                op2:=Nil;
                value:=eval(b,0)
              End;
            Forget(b);
            b:=h
          End
      End
  End;

FUNCTION copy(c:p):p;
  VAR h:p;
  BEGIN
    IF c=Nil THEN copy:=Nil
    ELSE
      BEGIN
        New(h);
        h^:=c^;
        h^.op1:=copy(c^.op1);
        h^.op2:=copy(c^.op2);
        copy:=h
      END
  END;

PROCEDURE Subst(a:p; VAR b:p);
  { In Funktion b wird fuer x jeweils eine Kopie von a eingesetzt }
  BEGIN
    IF b<>NIL THEN
      IF (b^.t=variable) AND (b^.name='x') THEN
        BEGIN dispose(b); b:=copy(a) END
      ELSE
        BEGIN
          Subst(a,b^.op1); Subst(a,b^.op2)
        END
  END;

FUNCTION diff(b:p):p;
  VAR h,h1,h2: p;
        b1,b2: boolean;
        e1,e2: atyp;

  FUNCTION Neulit(r:atyp):p;
    VAR hl:p;
    BEGIN
      New(hl);
      hl^.t:=literal;
      hl^.value:=r;
      hl^.name:=' ';
      hl^.op1:=Nil;
      hl^.op2:=Nil;
      Neulit:=hl
    END;

  FUNCTION Neuop(n:char; o1,o2:p):p;
    VAR hl:p;
    BEGIN
      New(hl);
      hl^.t:=operator;
      hl^.name:=n;
      hl^.op1:=o1;
      hl^.op2:=o2;
      hl^.value:=0;
      Neuop:=hl
    END;

  FUNCTION Neufun(nam:char; o:p):p;
    VAR hl:p;
    BEGIN
      New(hl);
      hl^.t:=funktion;
      hl^.name:=nam;
      hl^.op1:=o;
      hl^.op2:=Nil;
      hl^.value:=0;
      Neufun:=hl
    END;

  FUNCTION Null(h:p):boolean;
    BEGIN
      IF konstant(h) THEN
        Null:=eval(h,1)=0
      ELSE Null:=false;
    END;

  BEGIN
    CASE b^.t OF
      literal: h:=Neulit(0);
      variable: IF b^.name='x' THEN h:=Neulit(1) ELSE h:=Neulit(0);
      operator: BEGIN
                  h1:=diff(b^.op1); b1:=konstant(h1);
                  h2:=diff(b^.op2); b2:=konstant(h2);
                  IF b1 THEN e1:=eval(h1,0) ELSE e1:=-1;
                  IF b2 THEN e2:=eval(h2,0) ELSE e2:=-1;
                  CASE b^.name OF
                    '+','-': IF e2=0 THEN
                               IF e1=0 THEN
                                 BEGIN h:=neulit(0);
                                   Forget(h1); Forget(h2)
                                 END
                               ELSE
                                 BEGIN h:=h1; Forget(h2) END
                             ELSE
                             IF e1=0 THEN
                               BEGIN
                                 IF b^.name='+' THEN h:=h2
                                 ELSE h:=Neufun('-',h2);
                                 Forget(h1)
                               END
                             ELSE
                               h:=Neuop(b^.name,h1,h2);
                    '*': IF e1=0 THEN
                           IF e2=0 THEN
                             BEGIN
                               h:=Neulit(0); Forget(h1); Forget(h2)
                             END
                           ELSE
                           IF e2=1 THEN
                             BEGIN h:=copy(b^.op1); Forget(h1); Forget(h2) END
                           ELSE
                             BEGIN
                               h:=Neuop('*',copy(b^.op1),h2); Forget(h1)
                             END
                         ELSE
                         IF e2=0 THEN
                           BEGIN
                             h:=Neuop('*',copy(b^.op2),h1); Forget(h2)
                           END
                         ELSE
                         IF e1=1 THEN
                           BEGIN
                             h:=Neuop('+',copy(b^.op2),Neuop('*',copy(b^.op1),h2));
                             Forget(h1)
                           END
                         ELSE
                         IF e2=1 THEN
                           BEGIN
                             h:=Neuop('+',Neuop('+',h1,copy(b^.op2)),copy(b^.op1));
                             Forget(h2)
                           END
                         ELSE
                           h:=Neuop('+',Neuop('*',h1,copy(b^.op2)),Neuop('*',copy(b^.op1),h2));
                    '/': BEGIN
                           IF e2=0 THEN      { Nenner konstant }
                             BEGIN
                               h:=Neuop('/',h1,copy(b^.op2));
                               Forget(h2)
                             END
                           ELSE
                           IF e1=0 THEN      { Zähler konstant }
                             BEGIN
                               IF e2=1 THEN   { und Nenner 1-linear }
                                 BEGIN
                                   h:=Neuop('*',Neulit(-eval(b^.op1,0)),
                                                Neuop('^',copy(b^.op2),
                                                          Neulit(-2)));
                                   Forget(h1); Forget(h2)
                                 END
                               ELSE
                                 BEGIN
                                   h:=Neuop('*',
                                        Neuop('*',Neulit(-eval(b^.op1,0)),
                                                  h2),
                                        Neuop('^',copy(b^.op2),
                                                  Neulit(-2)));
                                   Forget(h1)
                                 END
                             END
                           ELSE
                             BEGIN          { Quotientenregel }
                               h:=Neuop('/',Neuop('-',
                               Neuop('*',h1,copy(b^.op2)),Neuop('*',copy(b^.op1),h2)),
                               Neuop('^',copy(b^.op2),Neulit(2)))
                             END
                         END;
                    '^': IF e2=0 THEN
                           BEGIN
                             e2:=eval(b^.op2,0);
                             IF e2=0 THEN          { f(x)^0 }
                               BEGIN h:=Neulit(0);
                                 Forget(h1); Forget(h2) END
                             ELSE
                             IF e2=1 THEN
                               BEGIN h:=h1; Forget(h2) END
                             ELSE
                             BEGIN     { f(x)^n }
                               IF e2=2 THEN h:=copy(b^.op1)   { f(x)^2 }
                               ELSE h:=Neuop('^',copy(b^.op1),Neulit(e2-1));
                               IF e1=1 THEN
                                 h:=Neuop('*',Neulit(e2),h)
                               ELSE h:=Neuop('*',Neuop('*',Neulit(e2),h1),h);
                               Forget(h2)
                             END
                           END
                         ELSE
                         IF e1=0 THEN
                           BEGIN e1:=eval(b^.op1,0);
                             IF e2=1 THEN    { a^x }
                               IF e1=e THEN     { e^x }
                                 BEGIN
                                   h:=Neufun('e',copy(b^.op2));
                                   Forget(h1); Forget(h2)
                                 END
                               ELSE               { a<>e }
                                 BEGIN
                                   h:=NeuOp('*',Neufun('l',copy(b^.op1)),
                                                NeuOp('^',copy(b^.op1),
                                                          copy(b^.op2)));
                                   Forget(h1); Forget(h2)
                                 END
                             ELSE           { a^f(x) }
                               IF e1=e THEN  { e^f(x) }
                                 IF e2=1 THEN    { e^x }
                                   BEGIN
                                     h:=Neufun('e',copy(b^.op2));
                                     Forget(h1);Forget(h2)
                                   END
                                 ELSE
                                   BEGIN
                                     h:=Neuop('*',h2,Neufun('e',copy(b^.op2)));
                                     Forget(h1)
                                   END
                               ELSE           { a<>e}
                               IF e2=1 THEN    { a^x }
                                 BEGIN
                                   h:=Neuop('*',Neufun('l',copy(b^.op1))
                                               ,copy(b));
                                   Forget(h1); Forget(h2)
                                 END
                               ELSE
                                 BEGIN
                                   h:=Neuop('*',Neuop('*',
                                                      Neufun('l',copy(b^.op1)),h2)
                                               ,copy(b));
                                   Forget(h1)
                                 END
                           END
                         ELSE           { g(x)^h(x) }
                           BEGIN
                             Forget(h1); Forget(h2);
                             h1:=Neufun('e',Neuop('*',copy(b^.op2),
                                                      Neufun('l',copy(b^.op1))));
                             h:=diff(h1);
                             Forget(h1)
                           END
                  END
                END;
      funktion: BEGIN h1:=copy(b^.op1); h2:=diff(h1);
                  CASE b^.name OF
                    '-': BEGIN h:=Neulit(-1); Forget(h1) END;
                    '+': h:=Neufun('v',h1);
                    'c': h:=NeuOp('*',Neulit(-1),Neufun('s',h1));
                    'e': h:=Neufun('e',h1);
                    'g': h:=Neuop('*',Neulit(ln(10)),Neuop('^',h1,Neulit(-1)));
                    'l': h:=Neuop('^',h1,Neulit(-1));
                    'o': h:=Neuop('*',Neulit(-1)
                                     ,NeuOp('^',Neufun('s',h1),Neulit(-2)));
                    'q': h:=Neuop('*',Neulit(2),h1);
                    'r': h:=Neuop('*',Neulit(0.5),
                                      NeuOp('^',h1,Neulit(-0.5)));
                    's': h:=Neufun('c',h1);
                    't': h:=NeuOp('^',Neufun('c',h1),Neulit(-2));
                    'v': BEGIN h:=Neulit(0); Forget(h1) END;
                    'C': h:=Neuop('*',Neulit(-1),
                                      Neuop('^',Neuop('-',Neulit(1),
                                                          Neufun('q',h1)),
                                                Neulit(-0.5)));
                    'O': h:=Neuop('*',Neulit(-1),
                                      Neuop('^',Neuop('+',Neulit(1),
                                                          Neufun('q',h1)),
                                                Neulit(-1)));
                    'S': h:=Neuop('^',Neuop('-',Neulit(1),
                                                Neufun('q',h1)),
                                      Neulit(-0.5));
                    'T': h:=Neuop('^',Neuop('+',Neulit(1),
                                                Neufun('q',h1)),
                                      Neulit(-1))
                  END;
                  IF konstant(h2) THEN e2:=eval(h2,0) ELSE e2:=-1;
                  IF e2=1 THEN
                    Forget(h2)
                  ELSE
                    h:=Neuop('*',h2,h)
                END
    End;
    diff:=h
  End;

FUNCTION GetNum(VAR tx:text; VAR z:char):integer;
  VAR i:integer;
  BEGIN
    i:=0;
    WHILE (z>='0') AND (z<='9') DO
      BEGIN
        i:=10*i + ord(z)-ord('0'); read(tx,z)
      END;
    GetNum:=i
  END;

PROCEDURE Inp(VAR tx:text; VAR i:p);

  VAR c:      char;
      err:    boolean;
      pos:    1..100;
      einstr: string[100];

  PROCEDURE gts;
    BEGIN
      IF err THEN c:=chr(0)
      ELSE
        BEGIN
          read(tx,c);
          IF (c>='A') AND (c<='Z') THEN
            c:=chr(ord(c)-ord('A')+ord('a'));
          einstr[pos]:=c;
          pos:=pos+1
        END
    END;

  PROCEDURE get;
    BEGIN REPEAT gts UNTIL c<>' ' END;

  FUNCTION Neu(tp:typ):p;
    VAR h:p;
    BEGIN
      New(h);
      WITH h^ DO
        BEGIN t:=tp; name:=' '; op1:=NIL; op2:=NIL; value:=0 END;
      Neu:=h
    END;

  PROCEDURE Fehler;
    BEGIN
      IF NOT err THEN
        BEGIN einstr[pos]:=chr(0);
          writeln('Error: ',einstr) END;
      c:=chr(0); err:=true
    END;

  PROCEDURE Summe(Var s:p);
    VAR t:p;

    PROCEDURE Term(Var h:p);
      VAR z,hlp:atyp; g:p; c1:char; num:integer;

      PROCEDURE Parameter;
        BEGIN
          iF c='(' THEN
            BEGIN
              get;
              Summe(h^.op1);
              IF c<>')' THEN Fehler;
              get
            END
          ELSE
            term(h^.op1)
        END;

      PROCEDURE Fun(n:char);
        BEGIN
          h:=Neu(funktion);
          h^.name:=n;
          get;
          Parameter
        END;

      BEGIN   { Term }
        h:=NIL;
        IF c='x' THEN
          BEGIN h:=Neu(variable); h^.name:='x'; get END
        ELSE
        IF ((c>='0') AND (c<='9')) or (c='.') THEN
          BEGIN
            z:=0;
            WHILE (c>='0') And (c<='9') DO
              BEGIN
                z:=round(10*z+ord(c)-ord('0'));
                gts
              End;
            h:=Neu(literal);
            IF c='.' THEN
              BEGIN gts; hlp:=1;
                WHILE (c>='0') AND (c<='9') DO
                  BEGIN
                    hlp:=hlp/10;
                    z:=z+hlp*round(ord(c)-ord('0'));
                    gts
                  END
              END;
            IF c='e' THEN
              BEGIN gts;
                IF c='-' THEN
                  BEGIN gts; num:=getnum(tx,c); z:=z*pwr10(-num) END
                ELSE
                  BEGIN
                    IF c='+' THEN gts;
                    num:=getnum(tx,c); z:=z*pwr10(num)
                  END
              END;
            IF c=' ' THEN get;
            h^.value:=z
          END
        ELSE
        If c='(' Then
          Begin get;
            Summe(h);
            If c<>')' Then Fehler;
            get
          End
        Else
        If c='-' Then Fun('-')
        Else
        If c='a' Then
          Begin gts;
            If c='r' Then
              Begin gts;
                If c='c' Then
                  Begin gts;
                    If c='c' Then
                      Begin gts;
                        If c='o' Then
                          Begin gts;
                            If c='s' Then Fun('C')        { arccos }
                            Else
                            If c='t' Then Fun('O')        { arccot }
                            Else Fehler
                          End
                        Else Fehler
                      End
                    Else
                    If c='s' Then
                      Begin gts;
                        If c='i' Then
                          Begin gts;
                            If c='n' Then Fun('S') Else Fehler { arcsin }
                          End
                        Else Fehler
                      End
                    Else
                    If c='t' Then
                      Begin gts;
                        If c='a' Then
                          Begin gts;
                            If c='n' Then Fun('T') Else Fehler { arctan }
                          End
                        Else Fehler
                      End
                    Else Fehler
                  End
                Else Fehler
              End
            Else
            If c='b' Then
              Begin gts;
                If c='s' Then Fun('+') Else Fehler         { abs }
              End
            Else                                           { a }
              BEGIN
                num:=getnum(tx,c);
                h:=Neu(literal);
                h^.value:=v['a',num]
              END
          End
        Else
        IF c='b' THEN                                      { b }
          BEGIN
            get; num:=getnum(tx,c);
            h:=neu(literal);
            h^.value:=v['b',num]
          END
        ELSE
        If c='c' Then
          Begin gts;
            If c='o' Then
              Begin gts;
                If c='s' Then Fun('c')              { cos }
                ELSE
                  IF c='t' THEN Fun('o')            { cot }
                  Else Fehler
              End
            ELSE
              BEGIN                                  { c }
                num:=getnum(tx,c);
                h:=Neu(literal);
                h^.value:=v['c',num]
              END
          END
        ELSE
        IF c='d' THEN
          BEGIN
            get;
            num:=getnum(tx,c);
            h:=Neu(literal);
            h^.value:=v['d',num]
          END
        ELSE
        If c='e' Then
          Begin gts;
            If c='x' Then
              Begin gts;
                If c='p' Then Fun('e') Else Fehler   { exp }
              End
            Else
              Begin                                  {  e  }
                h:=Neu(variable);
                h^.name:='e';
                If c=' ' Then get
              End
          End
        ELSE
        IF (c>='f') AND (c<='h') THEN       { f, g, h }
          BEGIN
            c1:=c; gts; num:=Getnum(input,c);
            IF f[c1,num]=NIL THEN Fehler
            ELSE
              BEGIN
                h:=copy(f[c1,num]);
                WHILE c='''' DO
                  BEGIN
                    get;
                    g:=h;
                    h:=diff(g);
                    Forget(g)
                  END;
                IF c=' ' THEN get;
                IF c='(' THEN
                  BEGIN get;
                    Summe(g);
                    Subst(g,h);
                    IF c<>')' THEN Fehler;
                    get;
                    Forget(g)
                  END
              END
          END
        ELSE
        IF c='l' THEN
          BEGIN gts;
            IF c='n' THEN Fun('l')
            ELSE
            IF c='g' THEN Fun('g')
            ELSE Fehler
          END
        ELSE
        IF c='p' THEN
          BEGIN gts;
            IF c='i' THEN
              BEGIN                                   { pi }
                h:=Neu(variable);
                h^.name:='p';
                get
              End
            Else Fehler
          End
        Else
        If c='s' Then
          Begin gts;
            If c='i' Then
              Begin gts;
                If c='n' Then Fun('s') Else Fehler   { sin }
              End
            Else
            If c='g' Then
              Begin gts;
                If c='n' Then Fun('v') Else Fehler    { sgn }
              End
            Else
            If c='q' Then
              Begin gts;
                If c='r' Then
                  Begin get;
                    If c='t' Then Fun('r')         { sqrt }
                     Else
                      Begin
                        h:=Neu(funktion);          { sqr }
                        h^.name:='q';
                        Parameter
                      End
                  End
                Else Fehler
              End
            Else Fehler
          End
        ELSE
        IF c='t' THEN
          BEGIN gts;
            IF c='a' THEN
              BEGIN gts;
                IF c='n' THEN Fun('t')
                ELSE Fehler
              END
            ELSE Fehler
          END

        ELSE Fehler;
        IF c='^' THEN
          BEGIN
            get;
            g:=neu(operator);
            g^.name:='^';
            g^.op1:=h;
            h:=g;
            Term(h^.op2)
          End;
        If (c>='a') and (c<='z') Or (c='(') Then
          Begin
            g:=Neu(operator);
            g^.op1:=h;
            h:=g;
            h^.name:='*';
            Term(h^.op2)
          End
      End;

    Procedure Produkt(Var h:p);
      Var hp:p;
      Begin
        Term(h);
        While (c='*') Or (c='/') Do
          Begin
            hp:=Neu(operator);
            hp^.name:=c;
            hp^.op1:=h;
            get;
            Term(hp^.op2);
            h:=hp
          End
      End;

    BEGIN { Summe }
      Produkt(s);
      WHILE (c='+') OR (c='-') DO
        BEGIN
          t:=Neu(operator);
          t^.name:=c;
          t^.op1:=s;
          get;
          Produkt(t^.op2);
          s:=t
        END
    END;

  BEGIN { Inp }
    i:=Nil; err:=false; pos:=1;
    get;
    Summe(i);
    write(chr(13));
    IF err THEN Forget(i)
  END;

PROCEDURE ReadKonst(VAR r:atyp; Var err:boolean);
  VAR f:p;
  BEGIN
    Inp(input,f);
    IF not konstant(f) Then
      Begin
        writeln('not konstant.');
        forget(f)
      End
    err:=f=Nil;
    If not err then
      BEGIN
        everr:=false;
        r:=eval(f,0);
        err:=everr
      END
  END;

PROCEDURE GetC;
  BEGIN REPEAT read(input,c) UNTIL c<>' ' END;

BEGIN { Main }
  page;
  writeln('Himpelsoft presents: Analysator');
  writeln;
  FOR i:=0 TO 99 DO
    BEGIN
      FOR c:='f' TO 'h' DO f[c,i]:=Nil;
      FOR c:='a' TO 'd' DO v[c,i]:=0
    End;
  assign(pr,'prt:');
  prt:=false;
  REPEAT
    loop:
    writeln; write('--> '); getc;
    if c<' ' then goto loop;
    CASE c OF
      'a','b','c','d':
          BEGIN
            c1:=c; getc; i:=Getnum(input,c);
            IF c<>'=' THEN GOTO 99;
            Inp(input,fx);
            IF fx<>NIL THEN
              BEGIN
                IF konstant(fx) THEN
                  BEGIN
                    y:=eval(fx,0);
                    IF everr THEN writeln('Error!')
                    ELSE
                      BEGIN
                        v[c1,i]:=y;
                        writeln(y)
                      END
                  END
                ELSE writeln('Variables nust be constant expressions.');
                forget(fx)
              END
          END
      'f','g','h':
          BEGIN
            c1:=c; getc; i:=Getnum(input,c);
            IF c<>'=' THEN GOTO 99;
            Inp(input,fx);
            IF fx<>NIL THEN
              BEGIN
                Forget(f[c1,i]); f[c1,i]:=fx;
                Infix(output,fx,0);
              END
          END
    '?':  BEGIN
            Inp(input,fx);
            If fx<>Nil Then
              IF konstant(fx) THEN
                BEGIN
                  everr:=false;
                  y:=eval(fx,0);
                  IF everr THEN writeln('Error')
                  ELSE
                    BEGIN
                      writeln(y);
                      IF prt THEN writeln(pr,y)
                    END
                END
              ELSE
                BEGIN
                  Infix(output,fx,0);
                  IF prt THEN
                    BEGIN
                      Infix(pr,fx,0);writeln(pr)
                    END
                END
          END
    't':  BEGIN
            Inp(input,fx);
            IF fx<>NIL Then
              Begin
                write('Wertetabelle von ');Infix(output,fx,0);
                writeln;
                write('untere Grenze: ');readkonst(lo,b);
                if b then goto loop;
                write('obere Grenze:  ');readkonst(hi,b);
                if b then goto loop;
                REPEAT
                  write('Schrittweite:  ');readkonst(step,b);
                  if b or (step=0) then goto loop;
                  IF abs(hi-lo)/abs(step)>=1e4 THEN
                    writeln('So viel Zeit hast Du bestimmt nicht.')
                UNTIL abs(hi-lo)/abs(step)<1e4;
                i:=0;
                x:=lo;
                writeln('      x       |    f(x)    ');
                writeln('--------------|------------');
                IF prt THEN
                  BEGIN
                    write(pr,'f(x) = ');
                    Infix(pr,fx,0);
                    writeln(pr);
                    writeln(pr);
                    writeln(pr,'      x       |    f(x)    ');
                    writeln(pr,'--------------|------------');
                  END
                IF sgn(hi-lo)=sgn(step) THEN
                Repeat
                  everr:=false;
                  y:=eval(fx,x);
                  IF everr THEN
                    BEGIN
                      writeln(x:12,'  |  ?');
                      IF prt THEN writeln(pr,x:12,'  |  ?')
                    END
                  ELSE
                    BEGIN
                      writeln(x:12,'  | ',eval(fx,x));
                      IF prt THEN writeln(pr,x:12,'  | ',eval(fx,x))
                    END;
                  i:=i+1;
                  x:=lo+i*step
                Until sgn(step)*(x-hi)>1e-5*abs(step)
             End
          END;
    'p':  BEGIN
            getc;
            CASE c OF
              '+':IF Not prt THEN
                    BEGIN
                      rewrite(pr);
                      IF eof(pr) THEN
                        BEGIN
                          writeln('File Error!'); close(pr)
                        END
                      ELSE prt:=true
                    END;
              '-':IF prt THEN
                    BEGIN
                      close(pr);
                      prt:=false
                    END;
              '=':BEGIN
                    readln(filename);
                    IF prt THEN close(pr);
                    assign(pr,filename);
                    IF prt THEN
                      BEGIN
                        rewrite(pr);
                        IF eof(pr) THEN
                          BEGIN
                            writeln('File Error!'); close(pr)
                          END
                      END
                  END
            OTHERWISE writeln('?')
            End
          END;
    'q':  writeln('See you later, Aligator!')
    OTHERWISE
      writeln;
      writeln('???')
    END;
    99: readln(input)
  UNTIL c='q';
  FOR i:=0 TO 99 DO
    FOR c:='f' TO 'h' DO Forget(f[c,i]);
  IF prt THEN close(pr)
  writeln
END.