From: invalid@invalid.invalid   
      
   Hi,   
      
   long years ago I made a parser for math functions with the argument x   
   and parameters like a, b, ...   
   It has the abilities to differentiate the function and calculate values from   
   given x.   
   If you wonder about some types I declared, then you should know, that I   
   ported it   
   from schtac pascal on a commodore 4032 to turbo pascal 5.   
   However it is german language.   
      
   Here is the main module diff.pas :   
   =======================   
   program  diff;   
      
   uses     crt,   
            zusatz,   
            Strings;   
      
   const    zlen      = 16;   
   type     t         = (arg,verkn,funkt,sconst,zconst);   
            p         = ^op;   
            op        = record   
                          case typ   : t of   
                               arg   :();   
                               verkn :(vkn    :char;   
                                       op1,op2:p;   
                                      );   
                               funkt :(fkt    :string;   
                                       opr    :p;   
                                      );   
                               sconst:(scn    :string);   
                               zconst:(zcn    :real);   
                        end;   
            cp        = ^cl;   
            cl        = record   
                          scn : string;   
                          zcn : real;   
                          nxt : cp;   
                        end;   
      
   var      fkt,dfkt  : p;   
            clist     : cp;   
            diffanz,i : integer;   
            x,f       : real;   
            erfolg    : boolean;   
            ch        : char;   
      
   function sign(x:real):integer;   
     begin   
       if x<>0 then   
         if x>0 then   
           sign:=+1   
         else   
           sign:=-1   
       else   
         sign:=0;   
     end;   
      
   procedure delbl(var s:string);   
     var i : integer;   
     begin   
       i:=1;   
       while i<=length(s) do   
         begin   
           if s[i]=' ' then   
             s:=copy(s,1,pred(i))+copy(s,succ(i),$ff)   
           else   
             inc(i);   
         end;   
     end; (* delbl *)   
      
   procedure strreal(zk:string; var z:real; var erfolg:boolean);   
     var code : integer;   
     begin   
       delbl(zk);   
       val(zk,z,code);   
       erfolg:=code=0;   
     end; (* strreal *)   
      
   procedure realstr(z:real; var zk:string);   
     var   ma    : real;   
           ex    : integer;   
           exk   : string;   
           sm    : integer;   
           nm    : integer;   
           i,ic  : integer;   
           d,e   : integer;   
           r     : real;   
      
     function ziff(i:integer):char;   
       begin   
         ziff:=chr(i+ord('0'));   
       end; (* ziff    *)   
      
     begin  (* realstr *)   
       nm:=zlen-6;   
       ma:=abs(z);   
       sm:=0;   
       if z<0 then sm:=1;   
       ex:=0;   
       zk:='';   
       if ma>0 then   
         begin   
           r:=5;   
           for i:=1 to nm do   
             r:=r/10;   
           if ma>=10 then   
             while ma>=10 do   
               begin   
                 ma:=ma/10;   
                 ex:=ex+1;   
               end   
           else   
             while ma<1 do   
               begin   
                 ma:=ma*10;   
                 ex:=ex-1;   
               end;   
           ma:=ma+r;   
           if ma>=10 then   
             begin   
               ma:=ma/10;   
               ex:=ex+1;   
             end;   
         end;   
       for i:=1 to nm do   
         begin   
           ic:=trunc(ma);   
           zk:=zk+ziff(ic);   
           ma:=(ma-ic)*10;   
         end;   
       ex:=ex-nm+1;   
       ic:=nm;   
       while (ic>1) and (zk[ic]='0') do   
         begin   
           dec(ic);   
           zk:=copy(zk,1,ic);   
           ex:=ex+1;   
         end;   
       if z=0 then   
         ex:=0;   
       if sm=1 then   
         begin   
           zk:='-'+zk;   
           ic:=ic+1;   
         end;   
       e:=2;   
       if ic-sm>1 then e:=3;   
       if nm-ice then   
         begin   
           ex:=ex+ic-1-sm;   
           if ic-sm>1 then   
             begin   
               insert('.',zk,sm+2);   
               ic:=ic+1;   
             end;   
           e:=zlen;   
           exk:=ziff(ex mod 10);   
           e:=e-1;   
           if ex>=10 then   
             begin   
               exk:=ziff(ex div 10)+exk;   
               e:=e-1;   
             end;   
           exk:='E'+exk;   
           zk:=zk+exk   
         end   
       else   
         if ex>=0 then   
           for i:=1 to ex do   
             zk:=zk+'0'   
         else   
           begin   
             ex:=abs(ex);   
             e:=ic-1-sm;   
             if ex<=e then   
               begin   
                 e:=ic+1-ex;   
                 insert('.',zk,e);   
               end   
             else   
               begin   
                 e:=ic-sm+2;   
                 if ic-sm=1 then e:=2;   
                 if ex<=e then   
                   begin   
                     d:=ex-ic+sm+2;   
                     if ic>zlen-d then ic:=zlen-d;   
                     insert(spc(d),zk,1+sm);   
                     for i:=1+sm to d+sm do   
                       zk[i]:='0';   
                     zk[2+sm]:='.';   
                   end   
                 else   
                   begin   
                     ex:=ex-ic+1+sm;   
                     if ic-sm>1 then   
                       begin   
                         insert('.',zk,2+sm);   
                         ic:=ic+1;   
                       end;   
                     e:=zlen;   
                     exk:=ziff(ex mod 10);   
                     e:=e-1;   
                     if ex>=10 then   
                       begin   
                         exk:=ziff(ex div 10)+exk;   
                         e:=e-1;   
                       end;   
                     exk:='-'+exk;   
                     e:=e-1;   
                     exk:='E'+exk;   
                     zk:=zk+exk;   
                   end;   
               end;   
           end;   
     end; (* realstr *)   
      
   procedure wrtf;   
      
     procedure w(f:p; ebene:integer);   
      
       var fehler : boolean;   
           zk     : string;   
      
       procedure wsum;   
         begin   
           fehler:=false;   
           if ebene>0 then write('(');   
           w(f^.op1,0);   
           write(f^.vkn);   
           w(f^.op2,0);   
           if ebene>0 then write(')');   
         end; (* wsum *)   
      
       procedure wdif;   
         begin   
           fehler:=false;   
           if ebene>0 then write('(');   
           if f^.op1^.typ=zconst then   
             begin   
               if f^.op1^.zcn<>0 then   
                 w(f^.op1,0);   
             end   
           else   
             w(f^.op1,0);   
           write(f^.vkn);   
           w(f^.op2,1);   
           if ebene>0 then write(')');   
         end; (* wdif *)   
      
       procedure wmul;   
         begin   
           fehler:=false;   
           if ebene>2 then write('(');   
           w(f^.op1,2);   
           write(f^.vkn);   
           w(f^.op2,2);   
           if ebene>2 then write(')');   
         end; (* wmul *)   
      
       procedure wquo;   
         begin   
           fehler:=false;   
           if ebene>2 then write('(');   
           w(f^.op1,2);   
           write(f^.vkn);   
           w(f^.op2,3);   
           if ebene>2 then write(')');   
         end; (* wquo *)   
      
       procedure wpot;   
         begin   
           fehler:=false;   
           if ebene>4 then write('(');   
           w(f^.op1,5);   
           write(f^.vkn);   
           w(f^.op2,4);   
           if ebene>4 then write(')');   
         end; (* wpot *)   
      
       begin  (* w    *)   
         fehler:=true;   
         if f=nil then   
           begin   
             fehler:=false;   
             write('?')   
           end   
         else   
           case f^.typ of   
             arg    : begin   
                        fehler:=false;   
                        write('x');   
                      end;   
             verkn  : case f^.vkn of   
                        '+': wsum;   
                        '-': wdif;   
                        '*': wmul;   
                        '/': wquo;   
                        '^': wpot;   
                      end;   
      
   [continued in next message]   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)