##
##    Title: 	gdev, glimit
##    Created:    Jun 87
##    Author:     Bruno Salvy
##        <salvy@poly>
##
## Description: 
##            gdev(expr,pt,<dir>,<order>);
##            glimit(expr,pt,<dir>);
##
##   gdev yields an expansion of expr at pt in the direction
## dir at the order order. glimit returns only the limit.
## - pt is either a number, or +/-infinity, or an equation
##    x = pt where x is the variable and pt follows the 
##    previous rules
## - dir is straight or inverse. Straight means "from 0" but in 0
##   where it means "from the right". Inverse means left for 0
##   and "from infinity" for other complex numbers.
##   Default dir is straight.
## - order is the number of non-zero terms in the expansion.
##   Default is one.
##
#######################################################

gdev:=proc()
local fct,pt,ord,var,rightdir, res, vars;
    if nargs<2 or nargs>4 then ERROR(`wrong number of arguments`) fi;
    fct:=args[1];
    if not type(fct,algebraic) then ERROR(`invalid argument`,fct) fi;
    vars:=indets(fct,name) minus {constants};
    if nops(")=0 then RETURN(fct)
    fi;
    if type(args[2],realcons) or
        (type(args[2],function) and op(0,args[2])=RootOf) then
        pt:=args[2];
        if nops(vars)=1 then
            var:=op(vars)
        else
            ERROR(`unspecified variable`)
        fi;
    elif type(args[2],equation) and type(op(1,args[2]),name)
#        and (type(op(2,args[2]),realcons) or
#        (type(op(2,args[2]),function)and op(0,op(2,args[2]))=RootOf))
        then
            if member(op(1,args[2]),vars) then
                var:=op(1,args[2]);
                pt:=op(2,args[2])
            else RETURN(fct) fi;
    elif type(args[2],name) then
        if member(args[2],vars) then
            var:=args[2];
            pt:=0
        else RETURN(fct)
        fi
    else ERROR(`Invalid point or variable`,args[2])
    fi;
    if has(pt,infinity) and pt<>infinity and pt<>-infinity then
        pt:=`simplify/infinity`(pt);
        if pt<>infinity and pt<>-infinity then
            ERROR(`Invalid limit point`,args[2])
        fi
    fi;
    rightdir:=true;
    if nargs>=3 then
        if type(args[3],integer) and args[3]>0 then
            ord:=args[3]
        elif type(args[3],name) and args[3]=`straight` or args[3]=`inverse` then
            if args[3]=`inverse` and pt<>infinity and pt<>-infinity then
                rightdir:=false
            fi
        else ERROR(`Invalid argument`,args[3])
        fi
    fi;
    if nargs=4 then
        if type(args[4],integer) and args[4]>0 and not assigned(ord) then
            ord:=args[4]
        elif type(args[4],name) and args[4]=`straight` or args[4]=`inverse` then
            if args[4]=`inverse` and pt<>infinity and pt<>infinity then
                rightdir:=false
            fi
        else ERROR(`Invalid argument`,args[4])
        fi
    fi;
    if not assigned(ord) then ord:=1 fi;
    if pt=infinity then
        res:=traperror(`dev/print`(`dev/dev`(subs(var=_Xasy,normal(fct)),
            ord,ord),var,ord))
    elif pt=-infinity then
        res:=subs(var=-var,traperror(`dev/print`(`dev/dev`(normal(
            subs(var=-_Xasy,fct)),ord,ord),var,ord)))
    elif testeq(pt)<>true then
        if rightdir then
            res:=subs(var=1/(1-var/pt),traperror(`dev/print`(`dev/dev`(normal(
                subs(var=pt*(1-1/_Xasy),fct)),ord,ord),var,ord)))
        else
            res:=subs(var=1/(var/pt-1),traperror(`dev/print`(`dev/dev`(
            normal(subs(var=pt*(1+1/_Xasy),fct)),ord,ord,true),var,ord)))
        fi
    else
        if rightdir then
            res:=subs(var=1/var,traperror(`dev/print`(`dev/dev`(normal(subs(
            var=1/_Xasy,fct)),ord,ord),var,ord)))
        else
            res:=subs(var=-1/var,traperror(`dev/print`(`dev/dev`(normal(
                subs(var=-1/_Xasy,fct)),ord,ord),var,ord)))
        fi
    fi;
    if "=lasterror then
        if "=undefined then RETURN(undefined)
        else gdev(args):='gdev(args)'; RETURN(")
        fi
    else RETURN(res)
    fi
end:

glimit:=proc()
local fct,pt,var,res,liste,i,rightdir, vars;
    if nargs<2 or nargs>3 then ERROR(`wrong number of arguments`) fi;
    fct:=args[1];
    vars:=indets(fct,name) minus {constants};
    if nops(")=0 then RETURN(fct)
    fi;
    if type(args[2],realcons) or
        (type(args[2],function) and op(0,args[2])=RootOf) then
        pt:=args[2];
        if nops(vars)=1 then
            var:=op(vars)
        else
            ERROR(`unspecified variable`)
        fi;
    elif type(args[2],equation) and type(op(1,args[2]),name) then
            if member(op(1,args[2]),vars) then
                var:=op(1,args[2]);
                pt:=op(2,args[2]) else RETURN(fct)
            fi
    elif type(args[2],name) then
        if member(args[2],vars) then
            var:=args[2];
            pt:=0
        else RETURN(fct)
        fi
    else ERROR(`Invalid point or variable`,args[2])
    fi;
    if has(pt,infinity) and pt<>infinity and pt<>-infinity then
        pt:=`simplify/infinity`(pt);
        if pt<>infinity and pt<>-infinity then
            ERROR(`Invalid limit point`,args[2])
        fi
    fi;
    rightdir:=true;
    if nargs=3 then
        if type(args[3],name) and args[3]=`straight` or args[3]=`inverse` then
            if args[3]=`inverse` and pt<>infinity and pt<>-infinity then
                rightdir:=false
            fi
        else ERROR(`Invalid direction`,args[3])
        fi
    fi;
    if pt=infinity then
        res:=traperror(`dev/dev`(subs(var=_Xasy,normal(fct)),1,1))
    elif pt=-infinity then
        res:=traperror(`dev/dev`(normal(subs(var=-_Xasy,fct)),1,1))
    elif testeq(pt)<>true then
        if rightdir then
            res:=traperror(`dev/dev`(normal(subs(var=pt*(1-1/_Xasy),fct)),1,1))
        else
            res:=traperror(`dev/dev`(normal(subs(var=pt*(1+1/_Xasy),fct)),1,1))
        fi
    else
        if rightdir then
            res:=traperror(`dev/dev`(normal(subs(var=1/_Xasy,fct)),1,1))
        else
            res:=traperror(`dev/dev`(normal(subs(var=-1/_Xasy,fct)),1,1))
        fi
    fi;
    if "=lasterror then
        if "=undefined then RETURN(undefined)
        else glimit(args):='glimit(args)';RETURN(")
        fi
    elif "=undefined then RETURN(undefined)
    fi;
    do
        if type(res,list) then
            evalr(Signum(res[3]));
            if "=1 then RETURN(0)
            elif "=-1 then
                `dev/lcoeff`(res);
                for i in indets(",function) do
                    if op(0,i)=sin or op(0,i)=cos then subs(i=[-1..1],") fi
                od;
                evalr(Signum("));
                if "=1 then RETURN(infinity)
                elif "=-1 then RETURN(-infinity)
                else RETURN(`undefined`)
                fi
            elif "=0 then res:=res[2]
            else RETURN(`undefined`)
            fi
        elif not has(res,_Xasytab) then
            RETURN(res)
        else
            res;
            for i in indets(",function) do
                if op(0,i)=sin or op(0,i)=cos then subs(i=[-1..1],") fi
            od;
            RETURN(evalr("))
        fi
    od;
end:

_equivX[1]:=1/_Xasy:

`simplify/infinity`:='readlib('`simplify/infinity`')':
evalr:='readlib('evalr')':

`dev/O`:=proc(dev)
    if dev=undefined then RETURN(undefined) fi;
    if not type(dev,list) then 1
    else
        [dev[1],`dev/O`(dev[2]),dev[3]]
    fi
end:

`dev/abs`:=proc(dev,n)
local impart, sig;
    if dev=undefined then RETURN(undefined) fi;
    if not type(dev,list) then evalc(abs(dev)) fi;
    impart:=`dev/impart`(dev);
    if not has(impart,I) then
        sig:=evalr(Signum(`dev/lcoeff`(dev)));
        if sig=1 then RETURN(dev)
        elif sig=-1 then RETURN(`dev/multbyreal`(dev,-1))
        elif sig=0 then RETURN([0])
        else ERROR(FAIL)
        fi
    else
        `dev/pow`(`dev/add`(`dev/pow`(`dev/realpart`(dev),2,n),
                                  `dev/pow`(subs(I=1,impart),2,n)),1/2)
    fi
end:

`dev/add`:=proc(U,V)
local i,j,result, res1, u,v,nu,nv, degu, degv, inter, sig, toadd1, toadd2;
option remember;
    if U=undefined or V=undefined then RETURN(undefined) fi;
    if not type(U,list) then
        if not type(V,list) then
            result:=U+V;
            if testeq(result)=true then RETURN(0) else RETURN(result) fi
        else
            if U=0 then RETURN(V)
            else
                nv:=nops(V);
                for i from 3 by 2 to nv do
                    sig:=evalr(Signum(V[i]));
                    if sig=1 then
                        RETURN([op(1..i-2,V),U,0,op(i-1..nv,V)])
                    elif sig=0 then
                        if type(V[i-1],list) then
                            res1:=`dev/add`([op(V[i-1]),0,infinity],U);
                            if type(res1,list) then
                                res1:=[op(1..nops(res1)-2,res1)] 
                            fi
                        else
                            res1:=`dev/add`(V[i-1],U)
                        fi;
                        if res1<>0 then
                            RETURN([op(1..i-2,V),res1,0,op(i+1..nv,V)])
                        else
                            RETURN(subsop(i-1=NULL,i=NULL,V))
                        fi
                    elif sig=FAIL then ERROR(FAIL)
                    fi
                od;
                RETURN(V)
            fi
        fi
    else
        if not type(V,list) then
            if V=0 then RETURN(U)
            else
                nu:=nops(U);
                for i from 3 by 2 to nu do
                    sig:=evalr(Signum(U[i]));
                    if sig=1 then
                        RETURN([op(1..i-2,U),V,0,op(i-1..nu,U)])
                    elif sig=0 then
                        if not type(U[i-1],list) then
                            res1:=`dev/add`(U[i-1],V)
                        else
                            res1:=`dev/add`([op(U[i-1]),0,infinity],V);
                            if type(res1,list) then
                                res1:=[op(1..nops(res1)-2,res1)]
                            fi
                        fi;
                        if res1<>0 then
                            RETURN([op(1..i-2,U),res1,0,op(i+1..nu,U)])
                        else
                            RETURN(subsop(i-1=NULL,i=NULL,U))
                        fi
                    elif sig=FAIL then ERROR(FAIL)
                    fi
                od;
                RETURN(U)
            fi
        else
            if op(1,U)=op(1,V) then
                u:=U;v:=V
            elif op(1,U)<op(1,V) then
                u:=U;
                if V[nops(V)]=infinity then
                    v:=[op(1,U),[op(1..nops(V)-2,V)],0,0,infinity]
                else
                    v:=[op(1,U),V,0]
                fi
            else
                if U[nops(U)]=infinity then
                    u:=[op(1,V),[op(1..nops(U)-2,U)],0,0,infinity]
                else
                    u:=[op(1,V),U,0]
                fi;
                v:=V
            fi
        fi
    fi;
    nu:=nops(u);
    nv:=nops(v);
    i:=3;
    j:=3;
    result:=[op(1,u)];
    while (i<=nu and j<=nv) do 
        degu:=u[i];
        degv:=v[j];
        if degu=infinity then result:=[op(result),op(j-1..nv,v)]; break fi;
        if degv=infinity then result:=[op(result),op(i-1..nu,u)]; break fi;
        sig:=evalr(Signum(degu-degv));
        if sig=1 then
            result:=[op(result),v[j-1],v[j]];
            j:=j+2
        elif sig=-1 then
            result:=[op(result),u[i-1],u[i]];
            i:=i+2
        elif sig=FAIL then ERROR(FAIL)
        else
            if i=nu or not type(u[i-1],list) then
                toadd1:=u[i-1]
            else
                toadd1:=[op(u[i-1]),0,infinity]
            fi;
            if j=nv or not type(v[j-1],list) then
                toadd2:=v[j-1]
            else
                toadd2:=[op(v[j-1]),0,infinity]
            fi;
            inter:=`dev/add`(toadd1,toadd2);
            if type(inter,list) and (i<nu or j<nv) then
                inter:=[op(1..nops(inter)-2,inter)]
            fi;
            if inter<>0 then
                    result:=[op(result),inter,degu]
            elif i=nu or j=nv then
                result:=[op(result),u[i-1],u[i]]
            fi;
            i:=i+2;
            j:=j+2
        fi
    od;
    if nops(result)=1 then
        if i>nu then result:=[u[1],u[nu-1],u[nu]]
        else result:=[v[1],v[nv-1],v[nv]]
        fi
    elif nops(result)=3 and result[3]=infinity then
        if type(result[2],list) then
            result:=[op(result[2]),0,infinity]
        else result:=0
        fi
    fi;
    RETURN(result)
end:

`dev/binomial`:=proc(z,w,n)
   `dev/prd`(`dev/GAMMA`(`dev/add`(z,1),n),
        `dev/pow`(`dev/prd`(`dev/GAMMA`(`dev/add`(w,1),n),
                `dev/GAMMA`(`dev/add`(`dev/add`(z,1),
                    `dev/multbyreal`(w,-1)),n)),-1,n))
end:

##
##    Title:     `dev/compare`
##    Created:    Jun-Aug 1988
##    Author:     Salvy Bruno
##
##  Compares two expansions Dev1 and Dev2.
##  Returns +1,-1 or 0.
##  0 means that the expansions are equal (even the multiplicative
##  constant).
##  This function is called by `dev/comparexplog` whose only user is
## `dev/exp`, thus here the constants cannot be functions of _X[].

`dev/compare`:=proc(Dev1,Dev2)
local i, dev1, dev2, n1, n2, sig;
    if not type(Dev1,list) then
        if not type(Dev2,list) then
            evalr(Signum(Dev1-Dev2))
        else
            sig:=evalr(Signum(Dev2[3]));
            if sig=1 then
                sig:=evalr(Signum(Dev1));
                if sig<>0 then sig else -`dev/compare`(Dev2[2],0) fi
            elif sig=-1 then
                -`dev/compare`(Dev2[2],0)
            elif sig=0 then
                `dev/compare`(Dev1,Dev2[2])
            else ERROR(FAIL)
            fi
        fi
    else
        if not type(Dev2,list) then
            sig:=evalr(Signum(Dev1[3]));
            if sig=1 then
                sig:=evalr(Signum(Dev2));
                if sig<>0 then sig else `dev/compare`(Dev1[2],0) fi
            elif sig=-1 then
                `dev/compare`(Dev1[2],0)
            elif sig=0 then
                `dev/compare`(Dev1[2],Dev2)
            else
                ERROR(FAIL)
            fi
        else
            if Dev1[1]<Dev2[1] then
                dev1:=Dev1;
                dev2:=[Dev1[1],Dev2,0]
            elif Dev1[1]>Dev2[1] then
                dev1:=[Dev2[1],Dev1,0];
                dev2:=Dev2
            else
                dev1:=Dev1;dev2:=Dev2
            fi;
            n1:=nops(dev1);n2:=nops(dev2);
            for i from 3 by 2 to min(n1,n2) do
                sig:=evalr(Signum(dev1[i]-dev2[i]));
                if sig=-1 then
                    RETURN(`dev/compare`(dev1[i-1],0))
                elif sig=1 then
                    RETURN(`dev/compare`(0,dev2[i-1]))
                elif sig=0 then
                    sig:=`dev/compare`(dev1[i-1],dev2[i-1]);
                    if sig<>0 then
                        RETURN(sig)
                    fi
                else
                    ERROR(FAIL)
                fi
            od;
            if n1=n2 then RETURN(0)
            elif n1<n2 then
                `dev/compare`(0,dev2[n1+1])
            else `dev/compare`(dev1[n2+1],0)
            fi
        fi
    fi
end:

###############################################################
#
#                                        DEV
#
#    The input to this procedure is :
#                            fct a function in _Xasy
#                            n     the order of the expansion
#                            p     its depth (number of non-zero terms)
#    The output is a development of the function in a generalized scale extending
#    ... ln(ln(x))^q ln(x)^r x^s exp(x)^t exp(exp(x))^u ...
# See the file structure for a description of the the data structure of 
# the expansions.
#
###############################################################

`dev/dev`:=proc(fct,p,n)
local inter,deve,prod,ind,l,deg, i, coef, newfct, expon, sig, fctname;
option remember;
    # allow a function already partly developed :
    if type(fct,list) then RETURN(fct) fi;
    # constants are not changed
    if not has(fct,_Xasy) and not hastype(fct,list) then
        if testeq(fct)=true then RETURN(0)
        else RETURN(fct) fi
    fi;
    # polynomials are the leaves of the expression --> chg of var
    if type(fct,polynom) then
        inter:=collect(frontend(expand,[fct]),_Xasy);
        if type(inter,`+`) then
            deg:=sort(map(degree,[op(inter)],_Xasy),proc(x,y) evalb(y<x) end)
        else deg:=[degree(inter,_Xasy)]
        fi;
        deve:=[1];
        for i in deg while nops(deve)<=2*n+7 do
            coef:=evalc(coeff(inter,_Xasy,i));
            if coef<>0 and (type(coef,{rational,name}) or testeq(coef)<>true) then
                deve:=[op(deve),coef,-i]
            fi;
        od;
        l:=nops(deve);
        if l<2*n+7 then 
            RETURN([op(deve),0,infinity])
        else
            RETURN(deve)
        fi
    elif type(fct,`+`) then
        deve:=0;
        for i in fct do
            deve:=`dev/add`(deve,`dev/dev`(i,p,n))
        od;
        if type(deve,list) then
            if type(op(1,deve),rational) then
                if deve[nops(deve)]<>infinity and `dev/length`(deve)<=p then
                    if n<p+3 then
                        RETURN(`dev/dev`(fct,p,n+min(3,n+1-`dev/length`(deve))))
                    else
                        newfct:=traperror(simplify(fct));
                        if newfct<>fct and testeq(newfct,fct)=true then
                            # all these testeq won't be needed when simplify is
                            # not bugged.
                            RETURN(`dev/dev`(newfct,p,n))
                        fi
                    fi
                fi
            fi
        fi
    elif type(fct,`*`) then
        deve:=1;
        for i in fct do
            deve:=`dev/prd`(deve,`dev/dev`(i,p,n))
        od;
        if type(deve,list) then
            if deve[1]<>true and deve<>undefined then
                if deve[nops(deve)]<>infinity and `dev/length`(deve)<=p then
                    if n<p+3 then
                        RETURN(`dev/dev`(fct,p,n+min(3,n+1-`dev/length`(deve))))
                    else
                        newfct:=traperror(simplify(fct));
                        if newfct<>fct and testeq(newfct,fct)=true then
                            RETURN(`dev/dev`(newfct,p,n))
                        fi
                    fi
                fi
            fi
        fi
    elif type(fct,`^`) then
        expon:=op(2,fct);
        if not has(expon,_Xasy) then
            # try to catch some divergent expansions there
            sig:=evalr(Signum(expon));
            if sig=-1 and type(op(1,fct),function) and op(0,op(1,fct))=`exp` then
                deve:=traperror(`dev/dev`(op(1,fct),p,n));
                if deve<>lasterror then
                    # we did not need to worry: it was convergent
                    RETURN(`dev/pow`(deve,expon,n))
                else
                    # we develop to the order n+1 to have the last
                    # interesting term with a minus sign
                    RETURN(`dev/dev`(exp(-op(op(1,fct)))^(-expon),p+1,n+1))
                fi
            else
                deve:=traperror(`dev/pow`(`dev/dev`(op(1,fct),p,n),expon,n))
            fi;
            if deve=lasterror or (type(deve,list) and deve[nops(deve)]<>infinity
                and `dev/length`(deve)<=p) then
                if n<p+2 then
                    RETURN(`dev/dev`(fct,p,n+min(3,1+n-`dev/length`(deve))))
                else
                    newfct:=traperror(simplify(fct));
                    if newfct<>fct and testeq(newfct,fct)=true then
                        RETURN(`dev/dev`(newfct,p,n))
                    elif deve=lasterror then ERROR(deve)
                    else ERROR(deve)
                    fi
                fi
            elif op(1,deve)=true then
                for i from 2 to nops(deve) do
                    inter:=deve[i][2];
                    if type(inter,list) and inter[nops(inter)]<>infinity
                         and `dev/length`(inter)<=p then
                        if n<p+2 then
                            RETURN(`dev/dev`(fct,p,n+min(3,n+1-`dev/length`(inter))))
                        else
                             newfct:=traperror(simplify(fct));
                             if newfct<>fct and testeq(newfct,fct)=true then
                                 RETURN(`dev/dev`(newfct,p,n))
                             fi
                        fi
                    fi
                od
            fi
        else RETURN(`dev/dev`(exp(expon*ln(op(1,fct))),p,n))
        fi
    elif type(fct,function) then
        fctname:=op(0,fct);
        if member(fctname,{ln,log}) then
            deve:=`dev/ln`(`dev/dev`(op(1,fct),p,n+1),n)
        elif fctname=`exp` then
            if type(op(fct),`*`) then
                prod:=1;ind:=1;
                for i in op(fct) do
                    if type(i,function) and op(0,i)=`ln` then
                        ind:=ind*i
                    else prod:=prod*i
                    fi
                od;
                if type(ind,function) and not has(prod,_Xasy) then
                   RETURN(`dev/dev`(op(ind)^prod,p,n))
                fi;
            fi;
            inter:=`dev/dev`(op(1,fct),p,n);
            deve:=traperror(`dev/exp`(inter,n));
            if deve<>`not a convergent development` then
                if deve=lasterror then ERROR(deve) fi;
                if op(1,deve)<>true then
                    if type(deve,list) and deve[nops(deve)]<>infinity and
                        `dev/length`(deve)<=p then
                        if n<p+3 then
                            RETURN(`dev/dev`(fct,p,n+min(3,1+n-`dev/length`(deve))))
                        else
                            newfct:=traperror(simplify(fct));
                            if newfct<>fct and testeq(newfct,fct)=true then
                                RETURN(`dev/dev`(newfct,p,n))
                            fi
                        fi
                    fi
                else
                    for i from 2 to nops(deve) do
                        inter:=deve[i][2];
                        if type(inter,list) and inter[nops(inter)]<>infinity and
                            `dev/length`(inter)<=p then
                             if n<p+3 then
                                RETURN(`dev/dev`(fct,p,n+min(3,1+n-
                                    `dev/length`(inter))))
                            else
                                newfct:=traperror(simplify(fct));
                                if newfct<>fct and testeq(newfct,fct)=true then
                                    RETURN(`dev/dev`(newfct,p,n))
                                fi
                            fi
                        fi
                    od
                fi
            elif n<p+3 then
                # sometimes trying a little further may help
                RETURN(`dev/dev`(fct,p,p+3))
            else ERROR(FAIL)
            fi
        elif fctname=`O` then
            RETURN(`dev/O`(`dev/dev`(op(fct),0,0)))
        elif member(fctname,{int,Int}) then
            deve:=traperror(`dev/int`(n,p,op(fct)));
            if deve=lasterror then ERROR(deve)
            elif `dev/length`(deve)<=p and n<p+3 then
                deve:=`dev/dev`(fct,p,n+min(3,1+n-`dev/length`(deve)))
            fi
        else
            if not type(`dev/`.(op(0,fct)),procedure) then
                ERROR(`Not implemented : `,`dev/`.(op(0,fct)))
            fi;
            deve:=traperror(`dev/`.(op(0,fct))(op(map(`dev/dev`,[op(fct)],
                p,n)),n));
            if op(1,deve)<>true then
                if deve=lasterror or (type(deve,list) and deve[nops(deve)]<>
                    infinity and `dev/length`(deve)<=p) then
                    if n<p+3 then
                        RETURN(`dev/dev`(fct,p,n+min(3,n+1-`dev/length`(deve))))
                    else
                        newfct:=traperror(simplify(fct));
                        if newfct<>fct and testeq(newfct,fct)=true then
                            RETURN(`dev/dev`(newfct,p,n))
                        elif deve=lasterror then ERROR(deve)
                        fi
                    fi
                elif deve=lasterror then ERROR(deve)
                fi
            else
                for i from 2 to nops(deve) do
                    inter:=deve[i][2];
                    if type(inter,list) and inter[nops(inter)]<>infinity and
                        `dev/length`(inter)<=p then
                        if n<p+3 then
                            RETURN(`dev/dev`(fct,p,n+min(3,1+n-`dev/length`(inter))))
                        else
                            newfct:=traperror(simplify(fct));
                            if newfct<>fct and testeq(newfct,fct)=true then    
                                RETURN(`dev/dev`(newfct,p,n))
                            fi
                        fi
                    fi
                od
            fi
        fi
    fi;
    deve
end:

##
##    Title:     `dev/endofdev`
##    Created:    Tue May 16 11:35:36 1989
##    Author:     Bruno Salvy
##        <salvy@tokay>
##
## Description: Input: a expansion tending to 0, an order, a polynomial.
##              Output: the substitution of the expansion in the polynomial,
## performing as few computations as possiblem, or at least as few as I could.
##  The polynomial is a list of coeff,deg. It is better if it is dense.

`dev/endofdev`:=proc (dev,k,Pol)
local n, res, posmin, mini, j, ind, pos, val, candidates, result, interm, i, comblin, p, devcoeff, exact, currdeg, degpol, pol, tocomp, sig;
    if dev=[1,1,1,0,infinity]then RETURN([1,op(1..min(2*k+2,nops(Pol)),Pol)])fi;
    if dev=undefined then RETURN(undefined) fi;
    n:=nops(dev);
    if dev[n]=infinity then
        exact:=true;
        n:=iquo(n,2)-1
    else
        exact:=false;
        n:=iquo(n,2)
    fi;
    # the exponents in the resulting expansion will be linear combinations
    # with positive integer coefficients of the exponents of the elements in
    # dev. The difficulty is that these exponents are not necessarily 
    # integers.
    # The first linear combination is 0:
    res:=[{[0$n]}];
    # which corresponds to the 0th-power
    val:=[0];
    # and whose value is 1:
    devcoeff[0$n]:=1;
    # At the begining, the maximal exponent of pol which may be used is the 
    # first one:
    pos:=1;
    if pos<n or exact then
        if type(dev[2*pos],list) then
            devcoeff[0$(pos-1),1,0$(n-pos)]:=[op(dev[2*pos]),0,infinity]
        else
            devcoeff[0$(pos-1),1,0$(n-pos)]:=dev[2*pos]
        fi
    else
        if type(dev[2*pos],list) then
            devcoeff[0$(pos-1),1,0$(n-pos)]:=dev[2*pos]
        else
            devcoeff[0$(pos-1),1,0$(n-pos)]:=1
        fi
    fi;
    # the corresponding exponent in the result will be the first one
    ind[1]:=1;
    # We need a dense representation of the polynomial:
    if Pol[nops(Pol)]=infinity then
        degpol:=Pol[nops(Pol)-2];
        pol:=array(0..degpol,sparse);
        for i by 2 to nops(Pol)-3 do pol[Pol[i+1]]:=Pol[i] od;
    else
        degpol:=Pol[nops(Pol)];
        pol:=array(0..degpol,sparse);
        for i by 2 to nops(Pol)-1 do pol[Pol[i+1]]:=Pol[i] od;
    fi;
    # the final expansion will be stored in result:
    if pol[0]<>0 then result:=[dev[1],pol[0],0];
    else result:=[dev[1]];
    fi;
    currdeg:=0;
    while (`dev/length`(result)<k+1) and currdeg<degpol
        and (exact or pos<n or ind[n]=1) do
        # Find the smallest possible exponent:
        mini:=dev[3]+val[ind[1]];
        # and the list of the corresponding multipliers:
        posmin:=[1];
        for j from 2 to pos do
            tocomp:=dev[2*j+1]+val[ind[j]];
            sig:=evalr(Signum(tocomp-mini));
            if sig=-1 then
                mini:=tocomp;
                posmin:=[j]
            elif sig=0 then posmin:=[op(posmin),j]
            fi
        od;
        # When the current maximal possible exponent is used for the first
        # time, then append the next one to the list of possible multipliers:
        if posmin[nops(posmin)]=pos and pos<n then
            pos:=pos+1;
            ind[pos]:=1;
            if pos<n or exact then
                if type(dev[2*pos],list) then
                    devcoeff[0$(pos-1),1,0$(n-pos)]:=[op(dev[2*pos]),0,infinity]
                else
                    devcoeff[0$(pos-1),1,0$(n-pos)]:=dev[2*pos]
                fi
            else
                if type(dev[2*pos],list) then
                    devcoeff[0$(pos-1),1,0$(n-pos)]:=dev[2*pos]
                else
                    devcoeff[0$(pos-1),1,0$(n-pos)]:=1
                fi
            fi
        fi;
        # Now use this information for the actual computation of the
        # expansion
        candidates:={};
        interm:=0;
        for j to nops(posmin) do
            for i in res[ind[posmin[j]]] do
                # the new linear combination:
                comblin:=[op(1..posmin[j]-1,i),i[posmin[j]]+1,
                    op(posmin[j]+1..n,i)];
                if not member(comblin,candidates) then
                    candidates:=candidates union {comblin};
                    # this necessitates the computation of a new product:
                    if i<>[0$n] then
                        devcoeff[op(comblin)]:=`dev/prd`(devcoeff[op(i)],
                            devcoeff[0$(posmin[j]-1),1,0$(n-posmin[j])])
                    fi;
                    # which we multiply by the proper coefficient to get the 
                    # result:
                    currdeg:=convert(['comblin[p]'$'p'=1..n],`+`);
                    if pol[currdeg]<>0 then
                        interm:=`dev/add`(interm,`dev/multbyreal`(
                            devcoeff[op(comblin)],pol[currdeg]
                            *currdeg!/convert(map(factorial,comblin),`*`)))
                    fi
                fi
            od;
            ind[posmin[j]]:=ind[posmin[j]]+1
        od;
        res:=[op(res),candidates];
        val:=[op(val),mini];
        if pos<n or exact or ind[n]=1 then
            if type(interm,list) then
                interm:=[op(1..nops(interm)-2,interm)]
            fi
        else
            if not type(interm,list) then interm:=1 fi
        fi;
        if interm<>0 then
            result:=[op(result),interm,mini]
        fi
    od;
    if `dev/length`(result)<k+1 and exact and pos=n then
        RETURN([op(result),0,infinity])
    else
        RETURN(result)
    fi
end: # `dev/endofdev`

##
##    Title:     `dev/exp`
##    Created:    June 87
##    Author:     Bruno Salvy
##        <salvy@tokay>
##
## Description: Computes the exponential of a development.
##
##    Modified:     Thu Apr 13 14:05:49 1989
##    Author:     Bruno Salvy
##    Modification: commented
##


`dev/exp`:=proc(u,n)
local i, v, badterms, coef, nu, result, j, newresult, sig, lcoef;
global _equivX;
option remember;
    # exp(undefined)=undefined
    if u=undefined then RETURN(undefined) fi;
    # constants
    if not type(u,list) then RETURN(evalc(exp(u))) fi;
    # The O() has to be small for the development of the exponential to
    # be convergent
    nu:=nops(u);
    if u[nu]<>infinity and evalr(Signum(u[nu]))=-1 then
        for badterms by 2 to nu-2 do
            if evalr(Signum(u[nu-badterms]))=-1 then
                break
            fi
        od;
        if badterms>nu-2 then ERROR(`Not a convergent development`)
        else
            v:=[u[1],u[badterms],u[badterms+1]]
        fi;
    # When the development is exact, there is no such problem:
    else
        badterms:=0;
        v:=1;
    fi;
    # Eventually, the result will be multiplied by v
    if nu-badterms>3 and u[5]<>infinity then
        # this means we have exp(a+b+..), so we compute exp(a)*exp(b)..
        result:=0;
        newresult:=v;
        for i from 2 by 2 to nu-badterms-1 while result<>newresult do
            result:=newresult;
            if u[i+1]<>0 and u[i+1]<>infinity then
                if not type(result,list) or result[nops(result)]=infinity then
                    newresult:=`dev/reduce`(`dev/prd`(result,`dev/exp`(
                        [u[1],u[i],u[i+1],0,infinity],n)),n)
                elif evalr(Signum(result[nops(result)]-u[i+1]))=1 then
                    newresult:=`dev/reduce`(`dev/prd`(result,`dev/exp`(
                        [u[1],u[i],u[i+1],0,infinity],`dev/exp/trunc`(
                            result[nops(result)]/u[i+1]))),n)
                else
                    break
                fi
            elif u[i+1]<>infinity then
                if type(u[i],list) then
                    newresult:=`dev/reduce`(`dev/prd`(result,`dev/exp`(
                        [op(u[i]),0,infinity],n)),n)
                else
                    newresult:=`dev/multbyreal`(result,`dev/exp`(u[i]))
                fi
            fi
        od;
        result:=newresult;
    else
        sig:=evalr(Signum(u[3]));
        if sig=1 then
            # if the degree is positive, then the expression tends to 0,
            # so we use 1+expr+expr^2/2+...
            coef:=1/6;
            lcoef:=[1,0,1,1,1/2,2,1/6,3];
            for j from 4 to n do coef:=coef/j;lcoef:=[op(lcoef),coef,j] od;
            result:=`dev/endofdev`(u,n,lcoef)
        elif u[3]=-1 and not type(u[2],list) and type(u[1],integer) then
            # if the degree is -1 then it has the form exp(exp(...(exp(z))))
            # and we compute it according to the scale
            if not assigned(_equivX[u[1]-1]) then
                _equivX[u[1]-1]:=1/exp(1/_equivX[u[1]])
            fi;
            result:=[u[1]-1,exp(`dev/instanc`(`dev/impart`(u[2]))
                /_Xasytab[u[1]]),-`dev/realpart`(u[2]),0,infinity]
        # In the common case, we have to compute the label we will give
        # to exp(X[order])
        else 
            if not type(u[2],list) then
                result:=`dev/multbyreal`(`dev/pow`(`dev/indexify`(exp([u[1],1,
                u[3]])),coeff(u[2],I,0),n),exp(`dev/instanc`([u[1],
                coeff(u[2],I,1),u[3],0,infinity])))
            else
                result:=`dev/multbyreal`(`dev/indexify`(exp([u[1],
                    [op(1..3,u[2])],u[3],0,infinity])),exp(`dev/instanc`([u[1],
                    `dev/impart`([op(1..3,u[2]),0,infinity]),u[3],0,infinity])));
                if nops(u[2])>3 then
                    if u[5]<>0 or nops(u)>5 then
                        result:=`dev/prd`(result,`dev/exp`(subsop(2=subsop(2=NULL,
                            3=NULL,u[2]),u),n))
                    else
                        result:=`dev/prd`(result,`dev/exp`([u[1],u[2][4],u[3],0,
                            infinity]))
                    fi
                fi
            fi
        fi;
        `dev/reduce`(`dev/prd`(v,result),n)
    fi
end:

`dev/exp/trunc`:=proc (x)
if type(x,integer) then x else trunc(evalf(x))+1 fi
end: # `dev/exp/trunc`

`dev/indexify`:=proc(expr)
local i, cst, fcn, toind, res;
if op(0,expr)=`ln` then
    # it can only be ln(X[rat]) and X[rat] must be some exponential
    res:=[1];
    for i from 2 while res[nops(res)]<>infinity do
        res:=`dev/dev`(ln(_equivX[op(op(expr))]),i,i,true)
    od
else
    if type(expr,list) then
        subsop(3=-1,`dev/placeit`(eval(subs(_Xasytab=_equivX,
            `dev/instanc`(expr)))))
    elif type(expr,exp(list)) then
        toind:=eval(subs(_Xasytab=_equivX,`dev/instanc`(op(expr))));
        if type(toind,`*`) then
            fcn:=1;cst:=1;
            for i in toind do 
                if has(i,_Xasy) then fcn:=fcn*i else cst:=cst*i fi
            od;
            subsop(3=-cst,`dev/placeit`(exp(fcn)))
        else
            subsop(3=-1,`dev/placeit`(exp(toind)))
        fi
    else ERROR(`bug`)
    fi
fi
end:

`dev/placeit`:=proc(expr)
local ord;
option remember;
ord:=`dev/Lorder`(expr);
`dev/findplace`(expr,-ord,ord)
end:

`dev/Lorder`:=proc(dev)
if not has(dev,`ln`) and not has(dev,`exp`) then 0
elif type(dev,function) then 1+procname(op(dev))
elif type(dev,`+`) or type(dev,`*`)then
    max(procname(op(1,dev)),procname(op(2,dev)))
elif type(dev,`^`) then
    procname(op(1,dev))+procname(op(2,dev))
else ERROR(`invalid expansion`,dev)
fi
end:

`dev/findplace`:=proc(devt,lim1,lim2)
local i, sig;
global _equivX;
if type(lim1,integer) and type(lim2,integer) and lim2-lim1>1 then
    i:=trunc((lim1+lim2)/2);
    if type(i,integer) and not assigned(_equivX[i]) then
        if i<=0 then
            _equivX[i]:=exp(_Xasy);
            to -i do _equivX[i]:=exp(_equivX[i]) od;
            _equivX[i]:=1/_equivX[i]
        else
            _equivX[i]:=ln(_Xasy);
            to i-2 do _equivX[i]:=ln(_equivX[i]) od;
            _equivX[i]:=1/_equivX[i]
        fi
    fi;
  sig:=`dev/comparexplog`(devt,eval(subs(_Xasytab=_equivX,
        `dev/instanc`([i,1,-1]))));
    if sig=1 then RETURN(procname(devt,lim1,i))
    elif sig=0 then RETURN([i,1,-1,0,infinity])
    else RETURN(procname(devt,i,lim2))
    fi
elif devt=1/eval(subs(_Xasytab=_equivX,`dev/instanc`([lim1,1,1]))) then
    [lim1,1,-1,0,infinity]
elif devt=1/eval(subs(_Xasytab=_equivX,`dev/instanc`([lim2,1,1]))) then
    [lim2,1,-1,0,infinity]
elif assigned(_equivX[(lim1+lim2)/2]) then
    sig:=`dev/comparexplog`(devt,1/eval(subs(_Xasytab=_equivX,
        `dev/instanc`([(lim1+lim2)/2,1,1]))));
    if sig=0 then [(lim1+lim2)/2,1,-1,0,infinity]
    elif sig=-1 then procname(devt,lim1,(lim1+lim2)/2)
    else procname(devt,(lim1+lim2)/2,lim2)
    fi
else _equivX[(lim1+lim2)/2]:=1/devt;
    [(lim1+lim2)/2,1,-1,0,infinity]
fi
end:

`dev/comparexplog`:=proc(u,v)
local sig;
if u=v then 0
elif not has(u,_Xasy) and not has(v,_Xasy) then
    sig:=evalr(Signum(u-v));
    if sig=FAIL then ERROR(FAIL) else sig fi;
elif type(u,function) and type(v,function) and op(0,u)=op(0,v) then
    procname(op(1,u),op(1,v))
elif type(u,function) and op(0,u)=`exp` then
    procname(op(u),expand(ln(v)))
elif type(u,function) and op(0,u)=`ln` and expand(u)<>u then
    `dev/compare`(`dev/dev`(expand(u),1,1,true),`dev/dev`(v,1,1,true))
elif type(u,`+`) or type(u,`^`) or type(u,`*`) then
    `dev/compare`(`dev/dev`(expand(ln(u)),1,1,true),
        `dev/dev`(expand(ln(v)),1,1,true))
else ERROR(`invalid development`,u)
fi
end:

`dev/factorial`:=proc(dev,n,X)
    `dev/GAMMA`(`dev/add`(dev,1),n)
end:

`dev/impart`:=proc(expr)
local i, result, n, impart;
    if not type(expr,list) then coeff(expr,I,1)*I
    else
        result:=[expr[1]];
        n:=nops(expr);
        for i from 2 by 2 to n-3 do
            if type(expr[i],list) then
                impart:=`dev/impart`([op(expr[i]),0,infinity]);
                if impart<>0 then result:=[op(result),impart,expr[i+1]] fi
            else
                impart:=coeff(expr[i],I,1);
                if impart<>0 then result:=[op(result),impart*I,expr[i+1]] fi
            fi
        od;
        if expr[n]=infinity then
            if result=[expr[1]] then 0
            else [op(result),0,infinity]
            fi
        else
            if type(expr[n-1],list) then
                [op(result),`dev/impart`(expr[n-1]),expr[n]]
            else
                [op(result),1,expr[n]]
            fi
        fi
    fi
end:

##
##    Title:     `dev/implicit`
##    Created:    Thu Jan 19 10:32:48 1989
##    Author:     Salvy Bruno
##        <salvy@poly>
##
##  Given two expansions expr1 and expr2, yields the expansion
## of y, where y is the solution of expr1(y)=expr2(x).
## Warning : this procedure will loop endlessly when the
## implicit equation is not solvable by this iterative method.
## A reasonable bound to put on the number of iterations would be 10.
## It must be called explicitly.
##
##  Because of possible ramifications, the result is a list of expansions.
##
## The second part (`dev/implicit/itersum`) should be made more efficient.
## A `dev/RootOf` should be written on top of this.

`dev/implicit`:=proc (expr1,expr2,p)
local x;
    if expr1=undefined or expr2=undefined then RETURN(undefined) fi;
    if expr1[3]=0 then
        `dev/implicit`(subsop(2=NULL,3=NULL,expr1),
            `dev/add`(expr2,`dev/multbyreal`(expr1[2],-1)),p)
    else
        if expr1[3]<>1 then
            map(op,map(proc(tomap,expr1,quote,expr2,p)
                `dev/implicit`(`dev/pow`(expr1,1/quote,p),
                `dev/multbyreal`(`dev/pow`(expr2,1/quote,p),tomap),p) end,
                map(evalc,[exp(2*I*'k'*Pi/expr1[3])$'k'=0..expr1[3]-1]),
                expr1,expr1[3],expr2,p))
        else
            if type(expr1[2],list) then
                `dev/implicit`(`dev/ln`(expr1,p),`dev/ln`(expr2,p),p)
            elif testeq(expr1[2]-1)<>true then
                `dev/implicit`(`dev/multbyreal`(expr1,1/expr1[2]),
                            `dev/multbyreal`(expr2,1/expr1[2]),p)
            elif `dev/length`(expr1)>1 and expr1[5]<>infinity then
                `dev/implicit`([expr1[1],1,1,0,infinity],
                    `dev/implicit/itersum`(`dev/dev`(subs(_Xasy=op(
                    `dev/implicit`([expr1[1],1,1,0,infinity],[1,1,1,0,infinity],p)),
                    eval(subs(_Xasytab=_equivX,
                    `dev/instanc`(`dev/add`([op(1..3,expr1),0,infinity],
                    `dev/multbyreal`(expr1,-1)))))),p,p),expr2,p),p)
            else
                if expr1[1]=1 then RETURN([expr2])
                else
                    subs(_Xasy=x,eval(subs(_Xasytab=_equivX,
                        1/`dev/instanc`([expr1[1],1,1],x))));
                    if op(0,")=`exp` then
                        `dev/implicit`(`dev/ln`([expr1[1],1,1,0,infinity],p,true),
                                    `dev/ln`(expr2,p,true),p)
                    elif op(0,")=`ln` then
                        `dev/implicit`(`dev/exp`([expr1[1],1,1,0,infinity],p,true),
                                    `dev/exp`(expr2,p,true),p)
                    else
                        ERROR(`should not happen`)
                    fi
                fi
            fi
        fi
    fi
end: # `dev/implicit`

`dev/implicit/itersum`:=proc(otherside,val,p)
local expr, res;
    expr:=normal(eval(subs(_Xasytab=_equivX,`dev/instanc`(otherside))));
    res:=val;
    to p do
        res:=`dev/reduce`(`dev/add`(val,`dev/dev`(subs(_Xasy=res,expr),p,p)),p)
    od
end:

`dev/instanc`:=proc(expr)
local i, res, lim, var;
    if not type(expr,list) then res:=expr
    else
        if expr[nops(expr)]<>infinity then
            lim:=nops(expr)
        else
            lim:=nops(expr)-2
        fi;
        res:=0;
        var:=_Xasytab[expr[1]];
        for i from 2 by 2 to lim do
            if type(expr[i],list) then
                res:=res+`dev/instanc`(expr[i])*var^expr[i+1]
            else
                res:=res+expr[i]*var^expr[i+1]
            fi
        od
    fi
end:

##
##    Title:     `dev/int`
##    Created:    Aug 1989
##    Author:     Bruno Salvy
##        <bsalvy@watmum>
##
## Description: asymptotics of integral by mellin transforms. Cannot do 
## everything, but quite a lot.
##
## It is easy to be much more efficient with the logarithms,
## it will be in the next version.

`dev/int`:=proc (n,n2,expr,eqn)
local inipoint, endpoint, t, cst, f, g, h, i, fcn, criticalpoints, listh,
locendpoint, locf, locinipoint, result, expg, j, d, indset, c, N1, m1, k, q,
m2, N2, p, melg, melf, s, expf, i1, i2, l, logpart, maxdifff, maxdiffg,
partres, r, a, res, newlisth, d2h, loc, locc, indic, x, const, deg, locbehav;
global _equivX;
    x:=_Xasy;
    if type(expr,procedure) then
        ERROR(`Cannot handle asymptotics of procedures`)
    elif not type(eqn,equation) then
        ERROR(`This has no meaning.`)
    fi;
    inipoint:=op(1,op(2,eqn));
    endpoint:=op(2,op(2,eqn));
    t:=op(1,eqn);
    if x=t then
        ERROR(`Stupid question`)
    fi;
    if not has({inipoint,endpoint,expr},x) then RETURN(Int(expr,eqn)) fi;
    fcn:=normal(expr);
    # Try to find fcn = cst(x)*f(t)*g(x*h(t))
    if not has(fcn,t) then
        RETURN(`dev/dev`(fcn*(endpoint-inipoint),n2,n))
    elif not has(fcn,x) then
#        int(fcn,t);
#        if type('"',function) and op(0,'"')=int then
            ERROR(`Not implemented yet`)
#        else
#            RETURN(`dev/dev`("*(endpoint-inipoint),n2,n))
#        fi
    else
        res:=traperror(`dev/int/niceform`(fcn,x,t));
        if res=lasterror then ERROR(`Too difficult`) fi;
        cst:=op(1,res);f:=op(2,res);g:=op(3,res);h:=op(4,res);
        # a small optimisation:
        if g=exp(x) then g:=exp(-x);h:=-h fi;
    fi;
    if h=false then
        RETURN(`dev/prd`(`dev/int`(n,n2,f,t=inipoint..endpoint),
            `dev/dev`(cst,n2,n)))
    fi;
    criticalpoints:=sort(map(proc(x) evalc(x); if not has(",I) then " fi end,
        [solve(diff(h,t),t)]),proc(x,y) evalb(signum(x-y)=-1) end);
#    if has(",Listinf) then ERROR(`Oscillating kernels not yet implemented`) fi;
    while nops(criticalpoints)>0 and signum(inipoint-criticalpoints[1])=1 do
        criticalpoints:=subsop(1=NULL,criticalpoints)
    od;
    while nops(criticalpoints)>0 and signum(criticalpoints[nops(criticalpoints)]
        -endpoint)=1 do
        criticalpoints:=subsop(nops(criticalpoints)=NULL,criticalpoints)
    od;
    criticalpoints:=[inipoint,op(criticalpoints),endpoint];
    listh:=[];
    # there must be a better way 
    d2h:=subs(x=100,diff(subs(x=x*h,g),t,t));
    for i from 2 to nops(criticalpoints)-1 do
        if traperror(signum(subs(t=criticalpoints[i],d2h)))<>-1 then next fi;
        locbehav:=`dev/dev`(subs(t=criticalpoints[i]+1/_Xasy,h),n2+1,n+1);
        if "[3]=0 then 
            loc:=`dev/implicit`(subsop(2=NULL,3=NULL,locbehav),
                [1,1,1,0,infinity],n);
            const[i]:=locbehav[3]
        else
            loc:=`dev/implicit`(locbehav,[1,1,1,0,infinity],n);
            const[i]:=0
        fi;
        if nops(loc)<2 then
            # it has to be an endpoint
            if i=1 then
                listh:=[[1,2,op(loc)]]
            elif i=nops(criticalpoints) then
                listh:=[op(listh),[i,i-1,op(loc)]]
            else ERROR(`bug`)
            fi
        else
            newlisth:=[];
            for j in loc do
                evalr(Signum(`dev/lcoeff`(j)));
                if "=-1 then newlisth:=[op(newlisth),[i,i-1,j]]
                elif "=1 then newlisth:=[op(newlisth),[i,i+1,j]]
                fi
            od;
            if nops(newlisth)<>2 then ERROR(FAIL)
            else
                listh:=[op(listh),op(newlisth)]
            fi
        fi
    od;
#    if nops(listh)=0 then # This part is not clean
#        evalr(Signum(inipoint));
#        if "=1 then
#             indic:=evalr(Signum(glimit(diff(subs(x=100*t,g)*f,t),
#                t=inipoint,inverse)))
#        elif "=-1 or "=0 then
#            indic:=evalr(Signum(glimit(diff(subs(x=100*t,g)*f,t),t=inipoint)))
#        else ERROR(FAIL)
#        fi
#    fi;
#    if (assigned(indic) and indic=1) or (
#        not(assigned(indic)) and not member({1,2},map(proc(x) {x[1],x[2]}
#     end,listh))) then
    if not member({1,2}, map(proc(x) {x[1],x[2]} end, listh)) then
        if inipoint<>-infinity then
            `dev/dev`(subs(t=inipoint+1/_Xasy,h),n2+1,n+1)
        else
            `dev/dev`(subs(t=-_Xasy,h),n2+1,n+1)
        fi;
        if "[3]=0 then
            `dev/implicit`(subsop(2=NULL,3=NULL,"),[1,1,1,0,infinity],n);
            const[1]:=""[2]
        else
            `dev/implicit`(",[1,1,1,0,infinity],n);
            const[1]:=0;
        fi;
        if nops("")<>1 then ERROR(FAIL) else listh:=[[1,2,op("")],op(listh)] fi
    fi;
#    if (assigned(indic) and indic=-1) or (not assigned(indic) and 
#        not member({nops(criticalpoints)-2,
#        nops(criticalpoints)-1},map(proc(x){x[1],x[2]} end, listh)))    then
    if not member({nops(criticalpoints)-1,nops(criticalpoints)},map(proc(x)
        {x[1],x[2]} end,listh)) then
        if endpoint<>infinity then
            `dev/dev`(subs(t=endpoint-1/_Xasy,h),n2+1,n+1)
        else
            `dev/dev`(subs(t=_Xasy,h))
        fi;
        if "[3]=0 then
            `dev/implicit`(subsop(2=NULL,3=NULL,"),[1,1,1,0,infinity],n);
            const[nops(criticalpoints)]:=""[2]
        else
            `dev/implicit`(",[1,1,1,0,infinity],n);
            const[nops(criticalpoints)]:=0
        fi;
        if nops("")<>1 then ERROR(FAIL) else listh:=[op(listh),
            [nops(criticalpoints),nops(criticalpoints)-1,op("")]] fi
    fi;
    result:=0;
    # cst(x).f(t).g(xt)
    expg:=`dev/dev`(g,n2,n);
    indset:=sort(convert(map(proc(x) op(1,x) end, indets(expg,list)),list));
    if indset[1]<=-1 or indset[nops(indset)]>2 then
        ERROR(`Too difficult`)
    elif expg[1]<1 then
        evalr(Signum(coeff(expg[3],I,0)));
        if "=-1 then
            d:=-expg[3];
            listh:=map(proc(x) -x end, listh);
            g:=subs(x=-x,g);
            expg:=`dev/dev`(g,n2,n)
        elif "=FAIL then
            ERROR(`Too difficult`)
        elif "=0 then
            # Should be able to handle Re(expon)=0 here.
            d:=0;
        else
            d:=expg[3]
        fi
    elif {op(indset)} minus {1,2} = {} then
        for i from 2 by 2 to nops(expg) do
            if not has(op(i,expg),{cos,sin}) or not has(op(i,expg),_Xasy[1]) then
                d:=0; break
            fi
        od;
        if i=nops(expg)+1 then
            d:=1 # the value here has no importance. It is a flag <>0
        fi
    fi;
    if d=0 then
        if hastype(indset,fraction) or indset[1]<1 then
            ERROR(`Too difficult`)
        else # it should be a list of the form [ 1, a_1, r[1],..., a_i, r[i],.. ]
            if expg[nops(expg)]<>infinity then
                m1:=iquo(nops(expg),2)
            else
                m1:=iquo(nops(expg),2)-1
            fi;
            for i to m1 do
                r[i]:=expg[2*i+1];
                if type(expg[2*i],list) then
                    if hastype(['expg[2*i][2*j+1]'$j=1..iquo(nops(expg[2*i]),2)],
                        fraction) or expg[2*i][nops(expg[2*i])]>0 then
                        ERROR(`Case not handled`)
                    else
                        N1[i]:=-expg[2*i][3];
                        deg:=0;
                        for l from nops(expg[2*i]) by -2 to 3 do
                            for j from deg to -expg[2*i][l]-1 do c[i,j]:=0 od;
                            deg:=-expg[2*i][l];
                            c[i,deg]:=expg[2*i][l-1]
                        od
                    fi
                else
                    N1[i]:=0;
                    c[i,0]:=expg[2*i]
                fi
            od
        fi
    fi;
    if type(g,ratpoly(anything,[x])) then g:=normal(g) fi;
    melg[0]:=mellin(g,x,s);
    maxdiffg:=0;
    for i in listh do
        indic:=evalr(Signum(criticalpoints[i[2]]-criticalpoints[i[1]]));
        if not has(criticalpoints[i[1]],infinity) then
            const[i[1]]+subs(_Xasy=1/(t-criticalpoints[i[1]]),eval(subs(
            _Xasytab=_equivX,`dev/instanc`(i[3]))))
        else
            const[i[1]]+subs(_Xasy=-indic*t,eval(subs(_Xasytab=_equivX,
                `dev/instanc`(i[3]))))
        fi;
        locf:=subs(t=",f)*diff(",t);
        evalr(Signum(criticalpoints[i[1]]));
        if (indic=1 and "=-1 or "=0) or (indic=-1 and "=1) then
            locinipoint:=glimit(h,t=criticalpoints[i[1]])
        else
            locinipoint:=glimit(h,t=criticalpoints[i[1]],inverse)
        fi;
        if "=undefined then ERROR(FAIL) fi;
        evalr(Signum(criticalpoints[i[2]]));
        if (indic=1 and "=1) or (indic=-1 and "=-1 or "=0) then
            locendpoint:=glimit(h,t=criticalpoints[i[2]])
        else
            locendpoint:=glimit(h,t=criticalpoints[i[2]],inverse)
        fi;
        if "=undefined then ERROR(FAIL) fi;
        if evalr(Signum(locendpoint-locinipoint))<>1 then
            locendpoint:=locinipoint;locinipoint:="";locf:=-locf
        fi;
        locf:=indic*locf;
        locc:=1;
        if evalr(Signum(locinipoint))<>1 then
            expf:=`dev/dev`(subs(t=1/_Xasy,locf),n2,n)
        else
            if d=0 or (g<>exp(-x)and g<>1/exp(x)) then
                locf:=locf*Heaviside(t-locinipoint);
                expf:=0
            else
                locc:=[0,1,locinipoint,0];
                locf:=subs(t=t+locinipoint,locf);
                expf:=`dev/dev`(subs(t=1/_Xasy,locf),n2,n)
            fi
        fi;
        if locendpoint<>infinity then
            locf:=locf*Heaviside(locendpoint-t)
        fi;
        indset:=sort([op(map(proc(x) op(1,x) end, indets(expf,list)))]);
        if nops(indset)=0 then q:=1
        elif indset[1]<=-1 or indset[nops(indset)]>2 then
            ERROR(`Too difficult`)
        elif indset[1]<1 then
            evalr(Signum(coeff(expf[3],I,0)));
            if "=-1 then
                ERROR(`Divergent integral`)
            elif "=FAIL then
                ERROR(`Too difficult`)
            elif "=0 then
                testeq(coeff(expf[3],I,1));
                if "=true then
                    q:=0;
                else
                    q:=expf[3]
                fi
            else
                q:=expf[3]
            fi
        elif {op(indset)} minus {1,2} = {}  then
            for k from 2 by 2 to nops(expf) do
                if not has(op(k,expf),{cos,sin}) or not has(op(k,expf),_Xasy[1]) 
                then q:=0;break
                fi
            od;
            if k=nops(expf)+1 then
                q:=1 # the value here has no importance. It is a flag <>0
            fi
        fi;
        if q=0 then
            if hastype(indset,fraction) or indset[1]<1 then
                ERROR(`Too difficult`)
            else # it should be a list of [ 1, c_1, a[1],..., c_i, a[i],.. ]]
                if expf[nops(expf)]<>infinity then
                    m2:=iquo(nops(expf),2)
                else
                    m2:=iquo(nops(expf),2)-1
                fi;
                for j to m2 do
                    a[j]:=expf[2*j+1];
                    if type(expf[2*j],list) then
                        if hastype(['expf[2*j][2*k+1]'$'k'=1..iquo(nops(expf[2*j]),
                            2)],fraction) or expf[2*j][nops(expf[2*j])]>0 then
                            ERROR(`Case not handled`)
                        else
                            N2[j]:=-expf[2*j][3];
                            deg:=0;
                            for k from nops(expf[2*j]) by -2 to 3 do
                                for l from deg to -1-expf[2*j][k] do p[j,l]:=0 od;
                                deg:=-expf[2*j][k];
                                p[j,deg]:=expf[2*j][k-1]*(-1)^deg
                            od
                        fi
                    else
                        N2[j]:=0;
                        p[j,0]:=expf[2*j]
                    fi
                od
            fi
        fi;
        # Check that definition strips of Mellin transforms overlap ?
        # Check lim(|y|-->infty,M[g,x+iy]M[f,x+iy])=0 ?
        if d<>0 and q<>0  then
            # there is often a change of variables to get the exponential factor,
            # but I do not know how to get it automatically in such a manner that
            # it never ends up in an infinite loop.
            ERROR(FAIL)
        elif d<>0 then
            if type('melg[0]',function) and op(0,'melg[0]')=mellin then
                ERROR(FAIL)
            fi;
            partres:=[1];
            for k to m2 do
                logpart:=[2];
                for j from 0 to N2[k] do
                    for l from maxdiffg+1 to N2[k] do
                        melg[l]:=diff(melg[l-1],s)
                    od;
                    maxdiffg:=max(maxdiffg,N2[k]);
                    convert([p[k,'l']*binomial('l',j)*'glimit(melg['l'-j],s=1+a[k])'
                        $'l'=j..N2[k]],`+`);
                    if has(",{undefined,infinity}) then ERROR(FAIL) fi;
                    if testeq(")<>true then
                        logpart:=[op(logpart),(-1)^j*",-j]
                    fi;
                od;
                if logpart<>[2] then
                    if N2[k]<>0 then
                        if not assigned(_equivX[2]) then _equivX[2]:=1/ln(_Xasy) fi;
                        partres:=[op(partres),logpart,1+a[k]]
                    else
                        partres:=[op(partres),logpart[2],1+a[k]]
                    fi
                fi
            od;
            if partres<>[1] then
                result:=`dev/add`(result,`dev/prd`(partres,locc))
            fi
        elif q<>0 then
            if type(locf,ratpoly(anything,[t])) then locf:=normal(locf) fi;
            melf[0]:=mellin(locf,t,s);
            if type('melf[0]',function) and op(0,'melf[0]')=mellin then
                ERROR(FAIL)
            fi;
            maxdifff:=0;
            partres:=[1];
            for k to m1 do
                logpart:=[2];
                for j from 0 to N1[k] do
                    for l from maxdifff+1 to N1[k] do
                        melf[l]:=diff(melf[l-1],s);
                    od;
                    maxdifff:=max(maxdifff,N1[k]);
                    convert([c[k,'l']*binomial('l',j)*'glimit(melf['l'-j],s=1-r[k])'
                        $'l'=j..N1[k]],`+`);
                    if has(",{undefined,infinity}) then ERROR(FAIL) fi;
                    if testeq(")<>true then
                        logpart:=[op(logpart),",-j]
                    fi;
                od;
                if logpart<>[2] then
                    if N1[k]=0 then
                        partres:=[op(partres),logpart[2],r[k]]
                    else
                        if not assigned(_equivX[2]) then _equivX[2]:=1/ln(_Xasy) fi;
                        partres:=[op(partres),logpart,r[k]]
                    fi
                fi
            od;
            if partres<>[1] then
                result:=`dev/add`(result,`dev/prd`(partres,locc));
            fi
        else
            if type('melg[0]',function) and op(0,'melg[0]')=mellin then
                ERROR(FAIL)
            fi;
            if type(locf,ratpoly(anything,[t])) then locf:=normal(locf) fi;
            melf[0]:=mellin(locf,t,s);
            if type('melf[0]',function) and op(0,'melf[0]')=mellin then
                ERROR(FAIL)
            fi;
            maxdifff:=0;
            i1:=1;
            i2:=1;
            partres:=[1];
            while (i1<=m1 and i2<=m2) or (i1=m1 and m1<nops(expg) and i2<=m2) 
                or (i2=m2 and m2<nops(expf) and i1<=m1) do
                evalc(r[i1]-1-a[i2]);
                evalr(Signum("));
                if "=1 then
                    logpart:=[2];
                    for j from 0 to N2[i2] do
                        for l from maxdiffg+1 to N2[i2] do
                            melg[l]:=diff(melg[l-1],s)
                        od;
                        maxdiffg:=max(maxdiffg,N2[i2]);
                        convert([p[i2,'l']*binomial('l',j)*'glimit(melg['l'-j],
                            s=1+a[i2])'$'l'=j..N2[i2]],`+`);
                        if has(",{undefined,infinity}) then ERROR(FAIL) fi;
                        if testeq(")<>true then
                            logpart:=[op(logpart),(-1)^j*",-j]
                        fi;
                    od;
                    if logpart<>[2] then
                        if N2[i2]<>0 then
                            if not assigned(_equivX[2]) then _equivX[2]:=1/ln(_Xasy)
                            fi;
                            partres:=[op(partres),logpart,(1+a[i2])]
                        else
                            partres:=[op(partres),logpart[2],(1+a[i2])]
                        fi
                    fi;
                    i2:=i2+1
                elif "=-1 then
                    logpart:=[2];
                    for j from 0 to N1[i1] do
                        for l from maxdifff+1 to N1[i1] do
                            melf[l]:=diff(melf[l-1],s);
                        od;
                        maxdifff:=max(maxdifff,N1[i1]);
                        convert([c[i1,'l']*binomial('l',j)*'glimit(melf['l'-j],
                            s=1-r[i1])'$'l'=j..N1[i1]],`+`);
                        if has(",{undefined,infinity}) then ERROR(FAIL) fi;
                        if testeq(")<>true then
                            logpart:=[op(logpart),",-j]
                        fi;
                    od;
                    if logpart<>[2] then
                        if N1[i1]=0 then
                            partres:=[op(partres),logpart[2],r[i1]]
                        else
                            if not assigned(_equivX[2]) then _equivX[2]:=1/ln(_Xasy)
                            fi;
                            partres:=[op(partres),logpart,r[i1]]
                        fi
                    fi;
                    i1:=i1+1
                elif "=FAIL then
                    break
                elif "=0 and testeq("")<>true then
                    ERROR(`Not yet implemented`) # it is the sum of both expansions
                else
                    logpart:=[2];
                    for j from 0 to N1[i1]+N2[i2]+1 do
                        if j<N1[i1]+N2[i2]+1 then
                            glimit(diff((s-r[i1])^(N1[i1]+N2[i2]+2)*melg[0]*
                                subs(s=1-s,melf[0]),s$N1[i1]+N2[i2]+1-j),s=r[i1])
                        else
                            glimit(normal((s-r[i1])^(N1[i1]+N2[i2]+2)*
                                melg[0]*subs(s=1-s,melf[0])),s=r[i1])
                        fi;
                        if has(",{undefined,infinity}) then ERROR(FAIL) fi;
                        if testeq(")<>true then
                            logpart:=[op(logpart),(-1)^(j+1)*"/j!/(N1[i1]+N2[i2]+1-j)!
                                ,-j]
                        fi;
                    od;
                    if logpart<>[2] then
                        if not assigned(_equivX[2]) then _equivX[2]:=1/ln(_Xasy) fi;
                        partres:=[op(partres),logpart,r[i1]]
                    fi;
                    i1:=i1+1;
                    i2:=i2+1
                fi
            od;
            if partres<>[1] then
                result:=`dev/add`(result,`dev/prd`(partres,locc))
            fi
        fi
    od;
    `dev/prd`(result,`dev/dev`(cst,n2,n))
end: # `dev/int`

`dev/int/niceform`:=proc (fcn,x,t)
local pow, cst, f, g, h, i, res, listg;
    if type(fcn,`^`) then
        pow:=op(2,fcn);
        if has(pow,x) then
            `dev/int/niceform`(exp(pow*ln(op(1,fcn))),x,t)
        else
            `dev/int/niceform`(op(1,fcn),x,t);
            [op(1,")^pow,op(2,")^pow,op(3,")^pow,op(4,")]
        fi
    elif type(fcn,function) then
        if nops(fcn)=1 then
            `dev/int/niceform2`(op(fcn),x,t);
            [1,1,op(0,fcn)(op(1,")),op(2,")]
        else
            h:=false;listg:=[];
            for i in fcn do
                res:=`dev/int/niceform2`(i,x,t);
                if h<>false then
                    if h<>op(2,res) and h<>-op(2,res) then
                        ERROR()
                    elif h=op(2,res) then
                        listg:=[op(listg),op(1,res)]
                    else
                        listg:=[op(listg),subs(x=-x,op(1,res))]
                    fi
                else
                    h:=op(2,res);
                    listg:=[op(listg),op(1,res)]
                fi
            od;
            [1,1,op(0,fcn)(op(listg)),h]
        fi
    elif type(fcn,`+`) then
        [1,1,op(`dev/int/niceform2`(fcn,x,t))];
    elif type(fcn,`*`) then
        cst:=1;f:=1;g:=1;h:=false;
        for i in fcn do
            if not has(i,x) then
                f:=f*i
            elif not has(i,t) then
                cst:=cst*i
            else
                res:=`dev/int/niceform`(i,x,t);
                if op(4,res)<>false then
                    if h<>false then
                        if h<>op(4,res) and h<>-op(4,res) then
                            if testeq(g,exp(x))=true then
                                if testeq(op(3,res),exp(x))=true then
                                    h:=h+op(4,res)
                                elif testeq(op(3,res),exp(-x)) then
                                    h:=h-op(4,res)
                                else
                                    ERROR()
                                fi
                            elif testeq(g,exp(-x)) then
                                if testeq(op(3,res),exp(x)) then
                                    h:=h-op(4,res);
                                elif testeq(op(3,res),exp(-x)) then
                                    h:=h+op(4,res)
                                fi
                            else
                                ERROR()
                            fi
                        elif h=op(4,res) then
                            g:=g*op(3,res)
                        else
                            g:=g*subs(x=-x,op(3,res))
                        fi
                    else
                        h:=op(4,res);
                        g:=g*op(3,res)
                    fi
                else
                    g:=g*op(3,res)
                fi;
                cst:=cst*op(1,res);
                f:=f*op(2,res)
            fi
        od;
        [cst,f,g,h]
    else
        ERROR()
    fi;
end: # `dev/int/niceform`

`dev/int/niceform2`:=proc (expr,x,t)
local g, h, i, j, res, lpow, rest;
    if not has(expr,{x,t}) then
        [1,false]
    elif type(expr,`+`) then
        g:=0;h:=false;
        for i in expr do
            res:=`dev/int/niceform2`(i,x,t);
            if op(2,res)<>false then
                if h<>false then
                    if h<>op(2,res) and h<>-op(2,res) then
                        ERROR()
                    elif h=op(2,res) then
                        g:=g+op(1,res)                        
                    else
                        g:=g+subs(x=-x,op(1,res))
                    fi
                else
                    h:=op(2,res);
                    g:=g+op(1,res)
                fi
            else
                g:=g+op(1,res)
            fi
        od;
        [g,h]
    elif type(expr,`*`) then
        if member(x,[op(expr)],'j') then
            h:=subsop(j=1,expr);
            if has(h,x) then ERROR() fi;
            [x,h]
        else
            lpow:=0;
            rest:=1;
            for i in expr do
                if type(i,`^`) and op(1,i)=x then
                    if lpow<>0 then ERROR()
                    else lpow:=op(2,i)
                    fi
                elif lpow<>0 then
                    if has(i,x) then ERROR()
                    else rest:=rest*i
                    fi
                elif has(i,x) then
                    break
                else
                    rest:=rest*i
                fi
            od;
            if lpow=0 then
                g:=1;h:=false;
                for i in expr do
                    res:=`dev/int/niceform2`(i,x,t);
                    if op(2,res)<>false then
                        if h<>false then
                            if h<>op(2,res) and h<>-op(2,res) then
                                ERROR()
                            elif h=op(2,res) then
                                g:=g+op(1,res)
                            else
                                g:=g+subs(x=-x,op(1,res))
                            fi
                        else
                            h:=op(2,res);
                            g:=g+op(1,res)
                        fi
                    else
                        g:=g+op(1,res)
                    fi
                od;
                [g,h]
            else
                # a little check for the sign
                traperror(signum(subs(t=1,rest)));
                if "=-1 then
                    [-x^lpow,(-rest)^(1/lpow)]
                else
                    [x^lpow,rest^(1/lpow)]
                fi
            fi
        fi
    elif type(expr,`^`) then
        if has(op(2,expr),x) then
            `dev/int/niceform2`(op(2,expr)*ln(op(1,expr)),x,t);
        else
            res:=`dev/int/niceform2`(op(1,expr),x,t);
            [op(1,res)^op(2,expr),op(2,res)]
        fi
    elif type(expr,name) then
        if expr=x then [x,1]
        else ERROR()
        fi
    else
        ERROR()
    fi;
end: # `dev/int/niceform2`

readlib(mellin):# alias did not work, to retry

`dev/lcoeff`:=proc(dev)
    if not type(dev,list) then dev
    else `dev/lcoeff`(dev[2])
    fi
end:

##
##    Title:     `dev/length`
##    Created:    Sun Aug 13 12:44:26 1989
##    Author:     Bruno Salvy
##        <bsalvy@watmum>
##
## Description: Returns the number of terms in an expansion.

`dev/length`:=proc (dev)
local i;
    if not type(dev,list) then RETURN(1)
    elif not hastype({op(dev)},list) then RETURN(iquo(nops(dev),2))
    else
        convert(map(`dev/length`,['dev[2*i]'$i=1..iquo(nops(dev),2)]),`+`)
    fi
end: # `dev/length`

##
##    Title:     `dev/ln`
##    Created:    Apr-Aug 1988
##    Author:     Bruno Salvy
##

`dev/ln`:=proc(u,n)
local res, deg, endexp, firsterm, nu, partres, firsterm1, init, newvar;
global _equivX;
option remember;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        if testeq(u-1)=true then RETURN(0) fi;
        traperror(evalr(Signum(abs(u))));
        if "=0 then ERROR(`ln(0)`)
        elif "=1 or "=-1 then
            RETURN(evalc(ln(u)))
        elif not type(u,constant) then
            # assume the user knows what he is doing
            RETURN(evalc(ln(u)))
        else ERROR(FAIL)
        fi
    fi;
    nu:=nops(u);
    if nu=5 and u[5]=infinity then
        deg:=u[3];
        if type(u[2],list) then
            init:=`dev/ln`([op(u[2]),0,infinity],n)
        else
            init:=`dev/ln`(u[2])
        fi;
        # Here is hidden X[n+1]=f(X[n]) :
        if type(u[1],integer) then
            if assigned(_equivX[u[1]+1]) then
                RETURN(`dev/add`(init,[u[1]+1,-deg,-1,0,infinity]))
            else
                _equivX[u[1]+1]:=1/ln(1/_equivX[u[1]]);
                RETURN(`dev/add`(init,[u[1]+1,-deg,-1,0,infinity]))
            fi
        else
            newvar:=`dev/indexify`(ln(_Xasytab[u[1]]));
            RETURN(`dev/add`(init,subsop(2=deg*newvar[2],newvar)))
        fi
    fi;
    res:=[];
    if nu=3 or u[5]=infinity then # don't need 1/firsterm
        endexp:=0
    else
        if type(u[2],list) then
            firsterm:=`dev/pow`([op(u[2]),0,infinity],-1,n);
        else 
            firsterm:=`dev/pow`(u[2],-1)
        fi;
        if u[3]<>0 then
            if op(nops(firsterm),firsterm)<>infinity then
                partres:=`dev/prd`([u[1],firsterm,-u[3],0,infinity],
                    [u[1],op(4..nu,u)])
            else
                partres:=`dev/prd`([u[1],[op(1..nops(firsterm)-2,
                    firsterm)],-u[3],0,infinity],[u[1],op(4..nu,u)])
            fi
        else
            partres:=`dev/prd`(firsterm,[u[1],op(4..nu,u)])
        fi;
        endexp:=`dev/ln/endofdev`(partres,n)
    fi;
    if type(u[2],list) then
        firsterm1:=`dev/ln`([op(u[2]),0,infinity],n);
        if firsterm1[nops(firsterm1)]=infinity then
            firsterm:=[op(1..nops(firsterm1)-2,firsterm1)]
        else
            firsterm:=firsterm1
        fi
    else
        firsterm:=`dev/ln`(u[2])
    fi;
    firsterm:=`dev/add`(`dev/reduce`(firsterm,n),`dev/multbyreal`(
                `dev/ln`([u[1],1,1,0,infinity],n),u[3]));
    if endexp = 0 then
        res:=firsterm
    else
        res:=`dev/add`(firsterm,endexp);
    fi;
    RETURN(`dev/reduce`(res,n))
end:

`dev/ln/endofdev`:=proc (dev,n)
    if dev=undefined then RETURN(undefined) fi;
    RETURN(`dev/endofdev`(dev,n,map(op,[[1/(2*'i'+1),2*'i'+1,-1/(2*'i'+2),
    2*'i'+2]$'i'=0..iquo(n,2)])))
end: # `dev/ln/endofdev`

`dev/multbyreal`:=proc(tree,r)
local i,res,prd;
    if r=0 then RETURN(0) fi;
    if tree=undefined then RETURN(undefined) fi;
    if not type(tree,list) then
        if type(r,numeric) then
            r*tree
        elif has(r,I) then subs(I^2=-1,r*tree)
        elif has(r,RootOf) and type(r,algnum) then `evala/Normal`(tree*r)
        else tree*r
        fi
    else
        if not hastype({op(tree)},list) then
            prd:=[tree[1],op(map(op,[[tree[2*i]*r,tree[2*i+1]]$
                i=1..iquo(nops(tree),2)]))];
            if type(r,numeric) then RETURN(prd)
            elif has(r,I) then RETURN(subs(I^2=-1,frontend(expand,prd)))
            elif has(r,RootOf) and type(r,algnum) then
                RETURN(map(`evala/Normal`,prd))
            else RETURN(prd)
            fi
        else
            res:=[tree[1]];
            for i from 2 by 2 to nops(tree) do
                res:=[op(res),`dev/multbyreal`(tree[i],r),tree[i+1]]
            od
        fi
    fi
end:

##
##    Title:     `dev/pow`
##    Created:    Apr-Aug 1988
##    Author:     Bruno Salvy
##
##    Modified:     Mon Feb 27 19:48:58 1989
##    Modification: better care for algnum
##

`dev/pow`:=proc(u,p,n)
local i, res1, res, ind, endexp, firsterm, firsterm1, nu, partres, binpow, q, lvar;
option remember;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        if type(u,constant) or p>=0 then
            RETURN(evalc(u^p))
        elif type(u,algnum) and has(u,RootOf) then
            RETURN(evala(Normal(u^p)))
        else
            # is u bounded away from 0 ?
            ind:=indets(u) minus {constants};
            lvar:=map(proc(x) if type(x,name) and 
                (not type(x,indexed) or op(0,x)<>_Xasytab) then x fi end,ind);
            if nops(lvar)=0 then
                if has(u,I) then
                    res1:=evalc(abs(u))
                else
                    res1:=u
                fi;
                for i in indets(res1,function) do
                    if op(0,i)=sin or op(0,i)=cos then
                        res1:=subs(i=[-1..1],res1)
                    fi
                od;
                res1:=evalr(res1);
                if evalr(Signum(op(1,op(res1))))=1 then
                    RETURN(u^p)
                else
                    RETURN(undefined)
                fi
            else
                # assume the user knows what he is doing
                RETURN(evalc(op(1,u)^p))
            fi
        fi
    fi;
    if type(p,integer) then
        if p>0 then
            q:=p;
            res:=1;
            binpow:=u;
            while q>1 do
                if irem(q,2)=1 then
                    res:=`dev/prd`(res,binpow)
                fi;
                binpow:=`dev/prd`(binpow,binpow);
                q:=iquo(q,2)
            od;
            RETURN(`dev/prd`(res,binpow))
        elif p=0 then RETURN(1)
        elif p<>-1 then
            `dev/pow`(`dev/pow`(u,-p,n),-1,n)
        fi
    fi;
    res:=[];
    nu:=nops(u);
    if nu=3 or u[5]=infinity then
        endexp:=1
    else
        if type(u[2],list) then
            firsterm:=`dev/pow`([op(u[2]),0,infinity],-1,n)
        else
            firsterm:=`dev/pow`(u[2],-1)
        fi;
        if u[3]<>0 then
            if not type(firsterm,list) or firsterm[nops(firsterm)]<>infinity then
                partres:=`dev/prd`([u[1],firsterm,-u[3],0,infinity],
                    [u[1],op(4..nu,u)])
            else
                partres:=`dev/prd`([u[1],[op(1..nops(firsterm)-2,
                    firsterm)],-u[3],0,infinity],[u[1],op(4..nu,u)])
            fi
        else
            if not type(firsterm,list) then
                partres:=`dev/multbyreal`([u[1],op(4..nu,u)],firsterm)
            else
                partres:=`dev/prd`(firsterm,[u[1],op(4..nu,u)])
            fi
        fi;
        endexp:=`dev/pow/endofdev`(partres,p,n)
    fi;
    if type(u[2],list) then
        firsterm1:=`dev/pow`([op(u[2]),0,infinity],p,n);
    else
        firsterm1:=`dev/pow`(u[2],p)
    fi;
    if u[3]<>0 then
        if op(nops(firsterm1),firsterm1)=infinity then
            firsterm:=[u[1],[op(1..nops(firsterm1)-2,firsterm1)],
                p*u[3],0,infinity]
        elif type(firsterm1,list) then
            firsterm:=[u[1],firsterm1,p*u[3]]
        else
            firsterm:=[u[1],firsterm1,p*u[3],0,infinity]
        fi
    else
        firsterm:=firsterm1
    fi;
    if nops(firsterm)=3 and p<0 and not type(firsterm[2],list) then 
        RETURN(undefined)
    fi;
    RETURN(`dev/prd`(firsterm,endexp))
end:

`dev/pow/endofdev`:=proc (dev,p,n)
local expr, j, i;
    if dev=undefined then RETURN(undefined) fi;
    expr:=[1,0,p,1,p*(p-1)/2,2];
    j:=p*(p-1)/2;
    for i from 3 to n do
        j:=j*(p-i+1)/i;
        expr:=[op(expr),j,i]
    od;
    RETURN(`dev/endofdev`(dev,n,expr))
end: # `dev/pow/endofdev`

`dev/prd`:=proc(U,V)
local deg, i, j, inter, u, v, candidate, deg1, exactu, exactv, 
finished, inter1, nu, nv, result, l, tomult1, tomult2, sig;
option remember;
    if U=undefined or V=undefined then RETURN(undefined) fi;
    if not type(U,list) then
        if not type(V,list) then
            if has(U,RootOf) or has(V,RootOf) then
                RETURN(normal(U*V))
            else
                RETURN(subs(I^2=-1,frontend(expand,[U*V])))
            fi
        else
            RETURN(`dev/multbyreal`(V,U))
        fi
    else
        if not type(V,list) then
            RETURN(`dev/multbyreal`(U,V))
        else
            if op(1,U)=op(1,V) then
                u:=U;v:=V
            elif op(1,U)<op(1,V) then
                u:=U;
                if V[nops(V)]=infinity then
                    v:=[op(1,U),[op(1..nops(V)-2,V)],0,0,infinity]
                else
                    v:=[op(1,U),V,0]
                fi
            else
                v:=V;
                if U[nops(U)]=infinity then
                    u:=[op(1,V),[op(1..nops(U)-2,U)],0,0,infinity]
                else
                    u:=[op(1,V),U,0]
                fi
            fi
        fi
    fi;
    nu:=nops(u);
    exactu:=evalb(u[nu]=infinity);
    nv:=nops(v);
    exactv:=evalb(v[nv]=infinity);
    finished:=false;
    deg:=[[u[3]+v[3],2,2]];
    # deg is a sorted list of n-uples whose first element is the total
    # degree, and the next ones are corresponding indices in u and v.
    result:=[u[1]];
#        result[1]:=u[1];
#        count:=1;
    while nops(deg)>0 and not finished do
        deg1:=deg[1];
        if (not exactu and member(nu-1,['deg1[2*i]'$
            'i'=1..iquo(nops(deg1),2)])) or
            (not exactv and member(nv-1,['deg1[2*i+1]'$
                'i'=1..iquo(nops(deg1),2)])) then
            finished:=true
        fi;
        inter1:=0;
        for i from 2 by 2 to nops(deg1) do
            if deg1[i]=nu-1 or not type(u[deg1[i]],list) then
                tomult1:=u[deg1[i]]
            else
                tomult1:=[op(u[deg1[i]]),0,infinity]
            fi;
            if deg1[i+1]=nv-1 or not type(v[deg1[i+1]],list) then
                tomult2:=v[deg1[i+1]]
            else
                tomult2:=[op(v[deg1[i+1]]),0,infinity]
            fi;
            inter:=`dev/prd`(tomult1,tomult2);
            if type(inter,list) and (deg1[i]<>nu-1 or deg[1][i+1]<>nv-1) and 
                inter[nops(inter)]=infinity then
                inter:=[op(1..nops(inter)-2,inter)]
            fi;
            inter1:=`dev/add`(inter1,inter);
        od;
        if inter1<>0 then
            result:=[op(result),inter1,deg1[1]]
#                result[count+1]:=inter1;result[count+2]:=deg1[1];count:=count+2
        elif finished then
            result:=[op(result),1,deg1[1]]
#                result[count+1]:=1;result[count+2]:=deg1[1];count:=count+2
        fi;
        if not finished then
            # rebuild deg
            deg:=subsop(1=NULL,deg);
            for i from 2 by 2 to nops(deg1) do
                if deg1[i]<>nu-1 and u[deg1[i]+3]<>infinity then
                    candidate:=u[deg1[i]+3]+v[deg1[i+1]+1];
                    for j to nops(deg) do
                        sig:=evalr(Signum(candidate-deg[j][1]));
                        if sig=-1 then
                            deg:=[op(1..j-1,deg),
                            [candidate,deg1[i]+2,deg1[i+1]],op(j..nops(deg),deg)];
                            break
                        elif sig=0 then
                            if not member([deg1[i]+2,deg1[i+1]],
                                ['[deg[j][2*l],deg[j][2*l+1]]'$
                                    l=1..iquo(nops(deg[j]),2)]) then
                                deg:=subsop(j=[op(deg[j]),deg1[i]+2,deg1[i+1]],deg)
                            fi;
                            break
                        elif sig=FAIL then
                            ERROR(FAIL)
                        fi;
                    od;
                    if j>nops(deg) then
                        deg:=[op(deg),[candidate,deg1[i]+2,deg1[i+1]]]
                    fi
                fi;
            od;
            for i from 2 by 2 to nops(deg1) do
                if deg1[i+1]<>nv-1 and v[deg1[i+1]+3]<>infinity then
                    candidate:=u[deg1[i]+1]+v[deg1[i+1]+3];
                    for j to nops(deg) do
                        sig:=evalr(Signum(candidate-deg[j][1]));
                        if sig=-1 then
                            deg:=[op(1..j-1,deg),
                            [candidate,deg1[i],deg1[i+1]+2],op(j..nops(deg),deg)];
                            break
                        elif sig=0 then
                            if not member([deg1[i],deg1[i+1]+2],
                                ['[deg[j][2*l],deg[j][2*l+1]]'$
                                    l=1..iquo(nops(deg[j]),2)]) then
                                deg:=subsop(j=[op(deg[j]),deg1[i],deg1[i+1]+2],deg)
                            fi;
                            break
                        elif sig=FAIL then
                            ERROR(FAIL)
                        fi;
                    od;
                    if j>nops(deg) then
                        deg:=[op(deg),[candidate,deg1[i],deg1[i+1]+2]]
                    fi
                fi
            od
        fi
    od;
    if (nops(result)=3 or (nops(result)=5 and result[5]=infinity)) and
        result[3]=0 then
        if nops(result)=3 then 
            RETURN(result[2])
        else
            RETURN([op(result[2]),0,infinity])
        fi
    elif not finished and type(result,list) then
        RETURN([op(result),0,infinity])
    else RETURN(result)
    fi
end:

`dev/print`:=proc(dev,var,n)
local res, limequ, i, result, bigO, nb;
    if dev=undefined then RETURN(undefined) fi;
    res:=eval(subs(_Xasytab=_equivX,
        `dev/print/nfirst`(dev,n+1,'nb','bigO')));
    if assigned(bigO) and bigO<>0 then
        limequ:=`simplify/O`(eval(O(eval(subs(_Xasytab=_equivX,
            `simplify/infinity`(bigO))))),_Xasy)
    else limequ:=0
    fi;
# This should not be the printer's job.
#        if has(res,GAMMA) then
#            res:=simplify(res,GAMMA)
#        elif has(res,RootOf) then
#            res:=simplify(res,RootOf)
#        elif hastype(res,trig) then
#            res:=simplify(res,trig)
#        fi;
    res:=eval(subs(_Xasytab=_equivX,res));
    res:=subs(_Xasy=var,res);
    limequ:=subs(_Xasy=var,limequ);
    result:=0;
    for i in res do
        result:=result+``(i)
    od;
    if limequ<>0 then
        result:=eval(result+``(limequ))
    else
        result:=eval(result)
    fi
end:

`dev/print/nfirst`:=proc (tree,n,total,bigO)
local var, i, nb, locO, k, res, rest, inter;
    if not type(tree,list) then
        if tree=0 then bigO:=0; total:=0; RETURN([]) fi;
        total:=1;
        if n=1 then bigO:=1 fi;
        RETURN([tree])
    else
        var:=_Xasytab[tree[1]];
        rest:=n;
        res:=[];
        for i from 2 by 2 to nops(tree) while rest>0 do
            inter:=`dev/print/nfirst`(tree[i],rest,'nb','locO');
            if not assigned(locO) then
                res:=[op(res),'inter[k]*var^tree[i+1]'$k=1..nb];
                rest:=rest-nb
            else
                res:=[op(res),'inter[k]*var^tree[i+1]'$k=1..nb-1];
                rest:=0;
                bigO:=locO*var^tree[i+1]
            fi
        od;
        total:=n-rest;
        res
    fi;
end: # `dev/print/nfirst`

`simplify/O`:=proc(f,var)
local a,i;
if not has(f,O) or nargs=1 then
    RETURN(f)
elif type(f,function) and op(0,f)=O then
    op(f);
    to 2 do
        `simplify/O/inO`(",var);
        expand(simplify("));
    od;
    if "<>0 then O(") else 0 fi
elif type(f,`*`) then
    [];
    for i to nops(f) do
        if type(op(i,f),function) and op(0(op(i,f)))=O then
            [op("),i]
        fi;
    od;
    if "<>[] then
        a:={op(")};
        1;
        for i to nops(a) do
            if member(i,a) then
                "*op(op(i,f))
            else "*op(i,f)
            fi;
        od;
        RETURN(`simplify/O`(O(simplify(")),var))
    else map(`simplify/O`,f,var)
    fi;
else map(`simplify/O`,f,var)
fi;
end:

`simplify/O/inO`:=proc (expr,var)
    if type(expr,constant) 
        and not has(expr,infinity) then
        if testeq(expr) then
            0
        else
            1
        fi;
    elif type(expr,name) then
        if expr=var then var else 1 fi
    elif type(expr,`+`) then
        map(procname,expr,var);
        if "<>expr then procname(",var) else expr fi
    elif type(expr,`^`) then
        evalc(op(2,expr));
        if has(",I) then
            procname(op(1,expr)^coeff(",I,0),var)
        else
            op(1,expr)^"
        fi
    elif type(expr,`*`) then
        map(procname,expr,var)
    elif type(expr,function) and op(0,expr)=exp then
        evalc(op(expr));
        if has(",I) then
            procname(exp(coeff(",I,0)),var)
        else
            expr
        fi
    elif type(expr,function) and (op(0,expr)=sin or op(0,expr)=cos) then 1
    elif type(expr,range) then
        procname(op(2,expr),var)
    else
        evalc(expr);
        if "<>expr then procname(",var) else expr fi
    fi;
end: # `simplify/O/inO`

`dev/realpart`:=proc(expr)
local i, result, n, realpart;
    if not type(expr,list) then coeff(expr,I,0)
    else
        result:=[expr[1]];
        n:=nops(expr);
        for i from 2 by 2 to n-3 do
            if type(expr[i],list) then
                realpart:=`dev/realpart`([op(expr[i]),0,infinity]);
                if realpart<>0 then result:=[op(result),realpart,expr[i+1]] fi
            else
                realpart:=coeff(expr[i],I,0);
                if realpart<>0 then result:=[op(result),realpart,expr[i+1]] fi
            fi
        od;
        if expr[n]=infinity then
            if result=[expr[1]] then 0
            else [op(result),0,infinity]
            fi
        else
            if type(expr[n-1],list) then
                [op(result),`dev/realpart`(expr[n-1]),expr[n]]
            else
                [op(result),1,expr[n]]
            fi
        fi
    fi
end:

# Given a development dev and an integer k, suppress the terms of order
# greater than k.

`dev/reduce`:=proc(dev,n)
local i, rest, result, l;
    if not type(dev,list) then RETURN(dev) fi;
    if not hastype({op(dev)},list) then
        RETURN([op(1..min(2*n+3,nops(dev)),dev)])
    fi;
    if `dev/length`(dev)<=n+1 then RETURN(dev) fi;
    result:=[dev[1]];
    rest:=n+1;
    for i from 2 by 2 to nops(dev) while rest<>0 do
        if not type(dev[i],list) then
            result:=[op(result),dev[i],dev[i+1]];
            rest:=rest-1
        else
            l:=`dev/length`(dev[i]);
            if l<=rest then
                result:=[op(result),dev[i],dev[i+1]];
                rest:=rest-l
            else 
                result:=[op(result),`dev/reduce`(dev[i],rest-1),dev[i+1]];
                rest:=0
            fi
        fi
    od;
    RETURN(result)
end:
 
`dev/sign`:=proc(dev)
    if not type(dev,list) then evalr(Signum(dev))
    else
        `dev/sign`[dev[2]]
    fi
end:

`dev/Si`:=proc(u,n)
local fact,i,x,example, sinus, cosinus, j, k, init, sig, invu, res, term;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list)then
        init:=traperror(Si(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        j:=-1/6;
        example:=[1,0,-1/18,1];
        for i from 2 to n do
            j:=-j/(4*i+2)/i;
            example:=[op(example),j/(2*i+1),i]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(`dev/pow`(u,2,n),n,example)))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        fact:=`dev/pow`(u,-2,n);
        cosinus:=`dev/cossin`(u,n);
        invu:=`dev/pow`(u,-1,n);
        sinus:=`dev/prd`(cosinus[2],invu);
        cosinus:=cosinus[1];
        res:=`dev/add`(Pi/2,`dev/add`(`dev/prd`(`dev/multbyreal`(cosinus,
            -1),invu),`dev/prd`(`dev/multbyreal`(sinus,-1),invu)));
        for i to trunc((n+1)/2)-1 do
            term:=`dev/prd`(term,fact);
            res:=`dev/add`(res,`dev/add`(`dev/prd`(`dev/multbyreal`(cosinus,
                (-1)^(i+1)*(2*i)!),term),`dev/prd`(`dev/multbyreal`(sinus,
                (-1)^(i+1)*(2*i+1)!),term)))
        od;
        RETURN(`dev/reduce`(res,n))
    elif sig=0 then
        init:=`dev/Si`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=Si(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/Si`

`dev/Ci`:=proc(u,n)
local fact,i,x,example, sinus, cosinus, j, k, init, sig, res, term, newres, 
invu, tomult;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(Ci(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        fact:=`dev/pow`(u,2,n);
        term:=1;
        res:=0;
        newres:=`dev/add`(gamma,`dev/ln`(u,n));
        for i to n-1 while (res<>newres) do
            res:=newres;
            term:=`dev/prd`(term,fact);
            newres:=`dev/add`(newres,
                `dev/multbyreal`(term,(-1)^i/(2*i)!/(2*i)))
        od;
        RETURN(`dev/reduce`(newres,n))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        invu:=`dev/pow`(u,-1,n);
        fact:=`dev/pow`(invu,2,n);
        sinus:=`dev/cossin`(u,n);
        cosinus:=`dev/prd`(sinus[1],invu);
        sinus:=sinus[2];
        res:=`dev/add`(`dev/prd`(sinus,fact),`dev/prd`(fact,`dev/multbyreal`(
            cosinus,-1)));
        tomult:=1;
        for i to trunc((n+1)/2) do
            tomult:=`dev/prd`(tomult,fact);
            res:=`dev/add`(res,`dev/add`(`dev/prd`(`dev/multbyreal`(sinus,
                (-1)^i*(2*i)!),tomult),`dev/prd`(`dev/multbyreal`(cosinus,
                (-1)^(i+1)*(2*i+1)!),tomult)))
        od;
        RETURN(`dev/reduce`(res,n))
    elif sig=0 then
        init:=`dev/Ci`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=Ci(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/Ci`

`dev/Ei`:=proc(u,n)
local fact,i,x, j, example, k, init, sig, tomult, res, newres;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(Ei(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        sig:=evalr(Signum(coeff(`dev/lcoef`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        fact:=u;
        tomult:=1;
        res:=0;
        newres:=`dev/add`(`dev/ln`(u,n),gamma);
        for i to n-1 while(res<>newres) do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(newres,`dev/multbyreal`(tomult,1/i/i!))
        od;
        RETURN(`dev/reduce`(newres,n))
    elif sig=-1 then
        fact:=`dev/pow`(u,-1,n);
        example:=[1,1,1,2,2,3,6,4,24,5,120,6];
        j:=120;
        for i from 6 to n do
            j:=j*i;
            example:=[op(example),j,i+1]
        od;
        RETURN(`dev/prd`(`dev/exp`(u,n),`dev/endofdev`(fact,n,example)))
    elif sig=0 then
        init:=`dev/Ei`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=Ei(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/Ei`

`dev/FresnelS`:=proc(u,n)
local fact,i,x,example, cosinus, sinus, k,j,init,sig,invu, newres, res, tomult;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(FresnelS(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        example:=[Pi/6,0];
        k:=Pi/2;
        for i to n do
            k:=-k*Pi^2/8/i/(2*i+1);
            example:=[op(example),k/(4*i+3),i]
        od;
        RETURN(`dev/prd`(`dev/pow`(u,3,n),
            `dev/endofdev`(`dev/pow`(u,4,n),n,example)))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        sinus:=`dev/cossin`(`dev/multbyreal`(`dev/pow`(u,2,n),Pi/2),n);
        cosinus:=sinus[1];
        invu:=`dev/pow`(u,-1,n);
        fact:=`dev/pow`(invu,2,n);
        sinus:=`dev/prd`(sinus[2],fact);
        fact:=`dev/pow`(fact,2,n);
        tomult:=1;
        res:=0;
        newres:=`dev/add`(1/2,`dev/add`(`dev/multbyreal`(`dev/prd`(cosinus,
            invu),-1/Pi),`dev/multbyreal`(`dev/prd`(sinus,invu),-1/Pi^2)));
        for i to trunc((n+1)/2) while res<>newres do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/add`(`dev/multbyreal`(`dev/prd`(
                cosinus,tomult),(-1)^(i+1)*product(2*'k'-1,'k'=1..2*i)/
                Pi^(2*i+1)),`dev/multbyreal`(`dev/prd`(sinus,tomult),(-1)^(i+1)*
                product(2*'k'-1,'k'=1..2*i+1)/Pi^(2*i+2))))
        od;
        RETURN(`dev/reduce`(newres,n))
    elif sig=0 then
        init:=`dev/FresnelS`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            example:=[init,0];
            j:=FresnelS(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/FresnelS`

`dev/FresnelC`:=proc(u,n)
local fact,i,x,example, sinus, cosinus, k, j, init,invu,newres,res,sig,tomult;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(FresnelC(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        example:=[1,0,-Pi^2/40,1];
        k:=-Pi^2/8;
        for i from 2 to n do
            k:=-k*Pi^2/8/i/(2*i-1);
            example:=[op(example),k/(4*i+1),i]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(`dev/pow`(u,4,n),n,example)))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        cosinus:=`dev/cossin`(`dev/multbyreal`(`dev/pow`(u,2,n),Pi/2),n);
        sinus:=cosinus[2];
        invu:=`dev/pow`(u,-1,n);
        fact:=`dev/pow`(invu,2,n);
        cosinus:=`dev/prd`(cosinus[1],fact);
        fact:=`dev/pow`(fact,2,n);
        res:=0;
        tomult:=1;
        newres:=`dev/add`(1/2,`dev/add`(`dev/multbyreal`(`dev/prd`(sinus,
            invu),1/Pi),`dev/multbyreal`(`dev/prd`(cosinus,invu),-1/Pi^2)));
        for i to trunc((n+1)/2) while newres<>res do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/add`(`dev/multbyreal`(`dev/prd`(sinus,
                tomult),(-1)^i*product(2*'k'-1,'k'=1..2*i)/Pi^(2*i+1)),
                `dev/multbyreal`(`dev/prd`(cosinus,tomult),(-1)^(i+1)*
                product(2*'k'-1,'k'=1..2*i+1)/Pi^(2*i+2))))
        od;
        RETURN(`dev/reduce`(newres,n))
    elif "=0 then
        init:=`dev/FresnelC`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=FresnelC(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/FresnelC`

`dev/Fresnelf`:=proc (u,n)
local fact,i,x,example, k,j, init, sig;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(Fresnelf(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        example:=[Pi,0];
        k:=Pi;
        for i to n-1 do
            k:=-k*Pi^2/(4*i+1);
            example:=[op(example),k,i]
        od;
        RETURN(`dev/add`(1/2,`dev/prd`(`dev/pow`(u,3,n-1),
            `dev/endofdev`(`dev/pow`(u,4,n-1),n-1,example))))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        example:=[1/Pi,0,-3/Pi^3,1];
        k:=-3/Pi^3;
        for i from 2 to n do 
            k:=-k*(4*i-1)*(4*i-3)/Pi^2;
            example:=[op(example),k,i]
        od;
        RETURN(`dev/prd`(`dev/pow`(u,-1,n),
            `dev/endofdev`(`dev/pow`(u,-4,n),n,example)))
    elif sig=0 then
        init:=`dev/Fresnelf`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=Fresnel(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end: # `dev/Fresnelf`

`dev/Fresnelg`:=proc (u,n)
local fact,i,x,example, k,j, init, sig;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(Fresnelg(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        example:=[-1,0,Pi^2/5,1];
        k:=Pi^2/5;
        for i from 2 to n-1 do 
            k:=-k*Pi^2/(4*i+1);
            example:=[op(example),k,i]
        od;
        RETURN(`dev/add`(1/2,`dev/prd`(u,
            `dev/endofdev`(`dev/pow`(u,4,n-1),n-1,example))))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        example:=[1/Pi^2,0,-15/Pi^4,1];
        k:=-15/Pi^4;
        for i from 2 to n do
            k:=-k*(16*i^2-1)/Pi^2;
            example:=[op(example),k,i]
        od;
        RETURN(`dev/prd`(`dev/pow`(u,-3,n),
            `dev/endofdev`(`dev/pow`(u,-4,n),n,example)))
    elif sig=0 then
        init:=`dev/Fresnelg`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            example:=[init,0];
            j:=Fresnelg(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end: # `dev/Fresnelg`

`dev/GAMMA`:=proc(u,n)
local fact,i,x,example, newu, j, example2, firstpart, k, init, sig;
option remember;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(GAMMA(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 or sig=0 and type(u[2],integer) and u[2]<0 then
        if sig=1 then
            newu:=u;
            i:=0;
            example:=[1,1,-1,0,infinity]
        else
            newu:=subsop(2=NULL,3=NULL,u);
            i:=u[2];
            example:=`dev/dev`(1/expand(convert([1-j*_Xasy$j=1..-i],`*`)),
                n,n,true);
            example:=[1,op(map(op,[[example[2*j],j-2]$
                j=1..iquo(nops(example),2)]))];
        fi;
        example2:=`dev/prd`(example,`dev/GAMMA`([1,1,0,1,1,0,infinity],n));
        RETURN(`dev/add`(`dev/multbyreal`(`dev/pow`(newu,-1,n),example2[2]),
            `dev/endofdev`(newu,n,subsop(1=NULL,2=NULL,3=NULL,example2))))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        firstpart:=`dev/multbyreal`(`dev/prd`(`dev/exp`(`dev/prd`(u,`dev/add`(
        -1,`dev/ln`(u,n))),n),`dev/pow`(u,-1/2,n)),(2*Pi)^(1/2));
        if `dev/length`(firstpart)>n and firstpart[nops(firstpart)]<>infinity
        then RETURN(firstpart) fi;
        example:=subsop(1=NULL,`dev/exp`(
            [1,op(map(op,[[bernoulli(2*i)/i/(4*i-2),2*i-1]$i=1..n+1]))],n+1));
        fact:=`dev/pow`(u,-1,n);
        RETURN(`dev/prd`(firstpart,`dev/endofdev`(fact,n,example)))
    elif sig=0 then
        # An important particular case
        if u[2]=1 and n<10 then
            RETURN(`dev/endofdev`(subsop(2=NULL,3=NULL,u),n,
            [1,0,-gamma,1,1/12*Pi**2+1/2*gamma**2,2,-1/3*Zeta(3)-1/12*Pi
            **2*gamma-1/6*gamma**3,3,1/160*Pi**4+1/3*Zeta(3)*gamma+
            1/24*Pi**2*gamma**2+1/24*gamma**4,4,-1/5*Zeta(5)-1/160*Pi**4
            *gamma-1/36*Zeta(3)*Pi**2-1/6*Zeta(3)*gamma**2-1/72*Pi**2*gamma**3
            -1/120*gamma**5,5,61/120960*Pi**6+1/5*Zeta(5)*gamma+1/320*
            Pi**4*gamma**2+1/18*Zeta(3)**2+1/36*Zeta(3)*Pi**2*gamma+1/18*
            Zeta(3)*gamma**3+1/288*Pi**2*gamma**4+1/720*gamma**6,6,
            -61/120960*Pi**6*gamma-1/18*Zeta(3)**2*gamma-1/5040*gamma**7-
            1/7*Zeta(7)-1/60*Zeta(5)*Pi**2-1/480*Pi**4*Zeta(3)-1/10*Zeta(5)*
            gamma**2-1/960*Pi**4*gamma**3-1/72*Zeta(3)*Pi**2*gamma**2-1/72*
            Zeta(3)*gamma**4-1/1440*Pi**2*gamma**5,7,1261/29030400*Pi**8+
            1/7*Zeta(7)*gamma+1/8640*gamma**6*Pi**2+1/216*Zeta(3)**2*Pi**2+
            1/40320*gamma**8+1/15*Zeta(5)*Zeta(3)+61/241920*Pi**6*gamma**2+
            1/480*Zeta(3)*gamma*Pi**4+1/36*Zeta(3)**2*gamma**2+1/60*Zeta(5)*
            Pi**2*gamma+1/30*Zeta(5)*gamma**3+1/3840*Pi**4*gamma**4+1/216*
            Zeta(3)*Pi**2*gamma**3+1/360*Zeta(3)*gamma**5,8,-1/162*
            Zeta(3)**3-61/362880*Pi**6*Zeta(3)-1/2160*gamma**6*Zeta(3)-
            1/60480*gamma**7*Pi**2-1/19200*gamma**5*Pi**4-1/362880*gamma**9
            -1/9*Zeta(9)-1261/29030400*Pi**8*gamma-1/84*Zeta(7)*Pi**2-1/800*
            Zeta(5)*Pi**4-1/14*Zeta(7)*gamma**2-1/108*Zeta(3)**2*gamma**3-
            61/725760*Pi**6*gamma**3-1/120*Zeta(5)*gamma**4-1/216*Zeta(3)**2*
            Pi**2*gamma-1/15*Zeta(5)*Zeta(3)*gamma-1/960*Zeta(3)*gamma**2*
            Pi**4-1/120*Zeta(5)*Pi**2*gamma**2-1/864*Zeta(3)*Pi**2*gamma**4,
            9]))
        elif type(u[2],integer) and u[2]>1 then
            example:=`dev/dev`(expand(convert([1+j*_Xasy$j=1..u[2]-1],`*`)),
                n,n,true);
            example:=[1,op(map(op,[[example[2*j],j-1]
                $j=1..iquo(nops(example),2)]))];
            if u[2]-1<n+1 then example:=subsop(2*u[2]+3=infinity,example) fi;
            example2:=`dev/GAMMA`([1,1,0,1,1,0,infinity],n);
            RETURN(`dev/endofdev`(subsop(2=NULL,3=NULL,u),n,subsop(1=NULL,
                `dev/prd`(example,example2))))
        else
            init:=`dev/GAMMA`(u[2],n);
            if init = undefined then RETURN(undefined) fi;
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(init)
            else
                example:=[init,0];
                j:=GAMMA(x);
                k:=1;
                for i to n do
                    j:=diff(j,x);
                    k:=k/i;
                    example:=[op(example),subs(x=u[2],j)*k,i]
                od;
                fact:=subsop(2=NULL,3=NULL,u);
                RETURN(`dev/endofdev`(fact,n,example))
            fi
        fi
    else ERROR(FAIL)
    fi
end:# `dev/GAMMA`

`dev/Psi`:=proc(u,n)
local fact,i,x,example, newu, j, firstpart, example2,k, invu, init, sig;
    if nargs=3 then RETURN(`dev/polygamma`(args)) fi;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(Psi(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 or sig=0 and type(u[2],integer) and u[2]<0 then
        if sig=1 then
            newu:=u;
            example:=[1,-1,-1,0,infinity]
        else
            newu:=subsop(2=NULL,3=NULL,u);
            i:=u[2];
            example:=`dev/dev`(normal(convert([1/(1-j*_Xasy)$j=1..-i],`+`)),
                n-1,n-1,true);
            example:=[1,-1,-1,op(map(op,[[-example[2*j],j-1]$j=1..n]))]
        fi;
        example2:=`dev/add`(`dev/Psi`([1,1,0,1,1,0,infinity],n-1),example);
        RETURN(`dev/add`(`dev/multbyreal`(`dev/pow`(newu,-1,n),example2[2]),
            `dev/endofdev`(newu,n,subsop(1=NULL,2=NULL,3=NULL,example2))))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        firstpart:=`dev/ln`(u,n);
        if `dev/length`(firstpart)>n and firstpart[nops(firstpart)]<>infinity 
            then RETURN(firstpart) fi;
        example:=map(op,[[-bernoulli(2*i)/2/i,i]$i=1..n]);
        invu:=`dev/pow`(u,-1,n);
        RETURN(`dev/add`(`dev/add`(firstpart,`dev/multbyreal`(invu,-1/2)),
            `dev/endofdev`(`dev/pow`(invu,2,n-1),n-1,example)))
    elif sig=0 then
        if u[2]=1 then
            RETURN(`dev/endofdev`(subsop(2=NULL,3=NULL,u),n,
            [-gamma,0,op(map(op,[[(-1)^i*Zeta(i),i-1]$'i'=2..n+1]))]))
        elif type(u[2],integer) then
            example:=`dev/dev`(normal(convert([1/(1+i*_Xasy)$i=1..u[2]-1],`+`
                )),n,n,true);
            example:=[1,op(map(op,[[example[2*i],i-1]$i=1..n+1]))];
            example2:=`dev/Psi`([1,1,0,1,1,0,infinity],n);
            RETURN(`dev/endofdev`(subsop(2=NULL,3=NULL,u),n,subsop(1=NULL,
                `dev/add`(example,example2))))
        else
            init:=`dev/Psi`(u[2],n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(init)
            else
                example:=[init,0];
                j:=Psi(x);
                k:=1;
                for i to n do
                    j:=diff(j,x);
                    k:=k/i;
                    example:=[op(example),subs(x=u[2],j)*k,i]
                od;
                fact:=subsop(2=NULL,3=NULL,u);
                RETURN(`dev/endofdev`(fact,n,example))
            fi
        fi
    else ERROR(FAIL)
    fi
end:# `dev/Psi`

`dev/polygamma`:=proc(k,u,n)
local fact,i,x,example, val, newu, example2, j, kfact, tomult, init, sig;
    if u=undefined then RETURN(undefined) fi;
    if not type(k,integer) then ERROR(FAIL) fi;
    if not type(u,list) then
        init:=traperror(Psi(k,u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 or sig=0 and type(u[2],integer) and u[2]<0 then
        kfact:=(-1)^(k+1)*k!;
        if sig=0 then
            val:=u[2];
            newu:=subsop(2=NULL,3=NULL,u);
            example:=`dev/dev`(normal(convert([1/(1-i*_Xasy)^(k+1)$i=1..-val],
                `+`)),n-1,n-1,true);
            example:=[1,kfact,-k-1,op(map(op,[[example[2*i]*kfact,i-1]
                $i=1..n]))]
        else val:=0; newu:=u;
            example:=[1,kfact,-k-1,0,infinity]
        fi;
        example2:=`dev/polygamma`(k,[1,1,0,1,1,0,infinity],n-1);
        RETURN(`dev/endofdev`(newu,n,subsop(1=NULL,`dev/add`(example,
            example2))))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        kfact:=(-1)^(k-1)*(k-1)!;
        example:=[kfact,k,kfact*k/2,k+1];
        for i to n-1 do
            kfact:=kfact*(2*i+k-1)*(2*i+k-2)/2/i/(2*i-1);
            example:=[op(example),kfact*bernoulli(2*i),2*i+k]
        od;
        RETURN(`dev/endofdev`(`dev/pow`(u,-1,n),n,example))
    elif sig=0 then
        if u[2]=1 then
            kfact:=k!;
            if irem(k,2)=0 then
                kfact:=-kfact;
                tomult:=(2*Pi)^(k+2)/2;
                example:=[kfact*Zeta(k+1),0,tomult/(k+2)*abs(bernoulli(k+2)),1];
                for i from 2 by 2 to n do
                    kfact:=kfact*(k+i)*(k+i-1)/i/(i-1);
                    tomult:=tomult*4*Pi^2/i/(i+1);
                    example:=[op(example),kfact*Zeta(k+1+i),i,tomult/(k+i+2)*
                        abs(bernoulli(k+i+2)),i+1]
                od
            else
                tomult:=(2*Pi)^(k+1)/2;
                kfact:=-kfact*(k+1);
                example:=[tomult/(k+1)*abs(bernoulli(k+1)),0,kfact*Zeta(k+2),1];
                for i from 2 by 2 to n do
                    tomult:=tomult*4*Pi^2/i/(i-1);
                    kfact:=kfact*(k+i+1)*(k+i)/(i+1)/i;
                    example:=[op(example),tomult/(k+i+1)*abs(bernoulli(k+i+1)),
                        i,kfact*Zeta(k+i+2),i+1]
                od
            fi;
            RETURN(`dev/endofdev`(subsop(2=NULL,3=NULL,u),n,example))
        elif type(u[2],integer) then
            kfact:=(-1)^k*k!;
            example:=`dev/dev`(normal(convert([1/(1+i*_Xasy)^(k+1)
                $i=1..u[2]-1],`+`)),n,n,true);
            example:=[1,op(map(op,[[example[2*i]*kfact,i-1]$i=1..n+1]))];
            example2:=`dev/polygamma`(k,[1,1,0,1,1,0,infinity],n);
            RETURN(`dev/endofdev`(subsop(2=NULL,3=NULL,u),n,subsop(1=NULL,
                `dev/add`(example,example2))))
        else
            init:=`dev/polygamma`(k,u[2],n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(init)
            else
                example:=[init,0];
                j:=Psi(k,x);
                kfact:=1;
                for i to n do
                    j:=diff(j,x);
                    kfact:=kfact/i;
                    example:=[op(example),subs(x=u[2],j)*kfact,i]
                od;
                fact:=subsop(2=NULL,3=NULL,u);
                RETURN(`dev/endofdev`(fact,n,example))
            fi
        fi
    else ERROR(FAIL)
    fi
end:# `dev/polygamma`

# The next version will have to be iterative ( it is not difficult )
`dev/W`:=proc(u,n)
local fact,i,x,example,l1,l2, j,k, init, sig, tomult;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        if testeq(op(1,u)+exp(-1))=true then
            RETURN(-1)
        else
            init:=traperror(simplify(W(op(1,u)),W));
            if init=lasterror then ERROR(init)
            else RETURN(evalc(init))
            fi
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        if coeff(`dev/lcoeff`(u[2]),I,1)<>0 then RETURN(undefined) fi;
        RETURN(`dev/endofdev`(u,n,map(op,[[(-1)^(i-1)*i^(i-1)/i!,i]$
            'i'=1..n+1])))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL)
        fi;
        l1:=`dev/ln`(u,n);
        l2:=`dev/ln`(l1,n);
        if n=1 then
            `dev/add`(l1,`dev/multbyreal`(l2,-1))
        elif n=2 then
            `dev/add`(`dev/add`(l1,`dev/multbyreal`(l2,-1)),
            `dev/prd`(l2,`dev/pow`(l1,-1,n)))
        elif n=3 then
            `dev/add`(`dev/add`(`dev/add`(l1,`dev/multbyreal`(l2,-1)),
            `dev/prd`(l2,`dev/pow`(l1,-1,n))),
            `dev/prd`(`dev/add`(`dev/multbyreal`(`dev/pow`(l2,2,n),1/2),
                                      `dev/multbyreal`(l2,-1)),
                         `dev/pow`(l1,-2,n)))
        elif n=4 then
            `dev/add`(`dev/add`(`dev/add`(`dev/add`(l1,`dev/multbyreal`
            (l2,-1)),`dev/prd`(l2,`dev/pow`(l1,-1,n))),
            `dev/prd`(`dev/add`(`dev/multbyreal`(`dev/pow`(l2,2,n),1/2),
                                      `dev/multbyreal`(l2,-1)),
                         `dev/pow`(l1,-2,n))),
            `dev/prd`(`dev/add`(`dev/multbyreal`(`dev/pow`(l2,3,n),-1/3),
                         `dev/add`(`dev/multbyreal`(`dev/pow`(l2,2,n),-3/2)
                            ,l2)),`dev/pow`(l1,-3,n)))
        else ERROR(`Not implemented`)
        fi;
        RETURN(`dev/reduce`(",n))
    elif sig=0 then
        init:=`dev/W`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            if testeq(u[2]+exp(-1))<>true then
                example:=[init,0];
                j:=W(x);
                k:=1;
                for i to n do
                    j:=diff(j,x);
                    k:=k/i;
                    example:=[op(example),subs(x=u[2],j)*k,i]
                od;
                fact:=subsop(2=NULL,3=NULL,u);
                RETURN(`dev/endofdev`(fact,n,example))
            else
                fact:=`dev/pow`(subsop(2=NULL,3=NULL,u),1/2,n);
                if `dev/length`(fact)>n and fact[nops(fact)]<>infinity then
                    RETURN(`dev/add`(`dev/multbyreal`(fact,2
                        ^(1/2)*exp(1/2)),-1))
                fi;
                ERROR(FAIL); # what is below is wrong.
                example:=[-1,0];
                for i from 2 to n do
                    tomult:=0;
                    for j to iquo(i-1,2) do
                        tomult:=tomult+(-1)^j*binomial(i+j,j-1)*
                            `dev/W/sumcoeff`(j,i+j-1)
                    od;
                    example:=[op(example),tomult*2^(i/2)*exp(1/2)^i,i];
                od;
                RETURN(`dev/endofdev`(fact,n,example))
            fi
        fi
    else ERROR(FAIL)
    fi
end:# `dev/W`

# This procedure computes
# \sum_{i_1+\cdots+i_{nb}=tot}{\prd{{i_p-1\over i_p!}}}, with i_p>=3.
`dev/W/sumcoeff`:=proc (nb,tot)
local i, res;
    if nb=1 then if tot>2 then RETURN(tot) else RETURN(0) fi fi;
    res:=0;
    for i from 3 to tot-3*(nb-1) do
        res:=res+(i-1)/i!*procname(nb-1,tot-i)
    od;
    RETURN(res)
end: # `dev/W/sumcoeff`

`dev/BesselJ`:=proc(nu,u,n)
local fact,i,x,example, sinus, cosinus, k,j, init, invu, newres,res,sig,tomult;
    if u=undefined then RETURN(undefined) fi;
    if type(nu,list) then ERROR(`Not implemented`)
    fi;
    if not type(u,list) then
        init:=traperror(BesselJ(nu,u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        j:=1/GAMMA(nu)/nu;
        example:=[j,0];
        for i to n do
            j:=-j/4/i/(nu+i);
            example:=[op(example),j,i]
        od;
        RETURN(`dev/multbyreal`(`dev/prd`(`dev/pow`(u,nu,n),
                        `dev/endofdev`(`dev/pow`(u,2,n),n,example)),1/2^nu))
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 then RETURN(undefined)
        elif sig=FAIL then ERROR(FAIL) fi;
        sinus:=`dev/cossin`(`dev/add`(-nu*Pi/2-Pi/4,u),n);
        cosinus:=sinus[1];
        invu:=`dev/pow`(u,-1,n);
        sinus:=`dev/prd`(sinus[2],invu);
        fact:=`dev/pow`(invu,2,n);
        tomult:=1;
        res:=0;
        newres:=`dev/add`(cosinus,`dev/multbyreal`(sinus,-(nu^2-1/4)/2));
        for i to trunc(n/2)+1 while (res<>newres) do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/add`(`dev/multbyreal`(`dev/prd`(cosinus,
                tomult),(-1)^i*product(4*nu^2-(2*'k'-1)^2,'k'=1..2*i)/8^(2*i)/
                (2*i)!),`dev/multbyreal`(`dev/prd`(sinus,tomult),(-1)^(i+1)*
                product(4*nu^2-(2*'k'-1)^2,'k'=1..2*i+1)/8^(2*i+1)/(2*i+1)!)
                ))
        od;
        res:=`dev/multbyreal`(`dev/prd`(newres,`dev/pow`(invu,1/2,n)),
            (2/Pi)^(1/2));
        if `dev/length`(res)>n and res[nops(res)]<>infinity then
            RETURN(res)
        elif res[nops(res)]=infinity then
            RETURN([op(1..nops(res)-2,res)])
        else RETURN(res)
        fi;
    elif sig=0 then
        init:=`dev/BesselJ`(nu,u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            example:=[init,0];
            j:=BesselJ(nu,x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/BesselJ`

`dev/Ai`:=proc(u,n)
local fact,i,x,example, expfact, cosinus, sinus, fact2, k, c1, c2, ck, example1
, example2, j, kfact, num1, num2, coef, init, sig, zeta;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(Ai(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        c1:=3^(-2/3)/GAMMA(2/3);c2:=-3^(-1/3)/GAMMA(1/3);
        num1:=1;num2:=1;kfact:=1;
        example:=[c1,0,c2,1];
        for i to n-1 do
            kfact:=kfact*(3*i-2)*(3*i-1)*3*i;
            num1:=num1*(3*i-2);
            num2:=num2*(3*i-1);
            example:=[op(example),c1*num1/kfact,3*i,c2*num2/kfact/(3*i+1),
                3*i+1]
        od;
        RETURN(`dev/endofdev`(u,n,example))
    elif sig=-1 then
        coef:=`dev/lcoeff`(u[2]);
        sig:=evalr(Signum(coeff(coef,I,0)));
        if sig=FAIL then ERROR(FAIL)
        elif sig=-1 and coeff(coef,I,1)=0 then
            zeta:=`dev/multbyreal`(`dev/pow`(u,3/2,n),2/3);
            fact:=`dev/pow`(zeta,-1,n+1);
            fact2:=`dev/pow`(fact,2,n+1);
            cosinus:=`dev/cossin`(`dev/add`(Pi/4,fact2),n);
            sinus:=cosinus[2];
            cosinus:=`dev/multbyreal`(`dev/prd`(cosinus[1],fact),-1);
            example1:=[1,1];
            example2:=[5/72,1];
            ck:=5/72;
            for i to iquo(n-1,2) do
                ck:=-ck*(12*i-1)*(12*i-5)/144/i;
                example1:=[op(example1),ck,i];
                ck:=ck*(12*i+5)*(12*i+1)/72/(2*i+1);
                example2:=[op(example2),ck,i]
            od;
            RETURN(`dev/multbyreal`(`dev/prd`(`dev/pow`(u,-1/4,n),`dev/add`(
            `dev/prd`(sinus,`dev/endofdev`(fact2,iquo(n+1,2),example1)),
            `dev/prd`(cosinus,`dev/endofdev`(fact2,iquo(n+1,2),example2)))),
            Pi^(-1/2)))
        else
            fact:=`dev/multbyreal`(`dev/pow`(u,3/2,n),2/3);
            expfact:=`dev/exp`(`dev/multbyreal`(fact,-1),n+1);
            if `dev/length`(expfact)>n and expfact[nops(expfact)]<>infinity 
            then
                RETURN(`dev/reduce`(`dev/multbyreal`(`dev/prd`(`dev/pow`(
                u,-1/4,n),expfact),1/2/Pi^(-1/2)),n))
            else
                fact:=`dev/pow`(fact,-1,n);
                example:=[1,0];
                ck:=1;
                for i to n do
                    ck:=-ck*(6*i-5)*(6*i-1)/72/i;
                    example:=[op(example),ck,i]
                od;
                RETURN(`dev/reduce`(`dev/multbyreal`(`dev/prd`(`dev/prd`(
                `dev/pow`(u,-1/4,n),`dev/endofdev`(fact,n,example)),
                expfact),1/2/Pi^(1/2)),n))
            fi
        fi
    elif sig=0 then
        init:=`dev/Ai`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=Ai(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/Ai`

`dev/dilog`:=proc(u,n)
local fact,i,x,example,itsln,j,k, init, newres, res, sig, tomult;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(dilog(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        `dev/lcoeff`(u[2]);
        fact:=u;
        itsln:=`dev/ln`(u,n);
        tomult:=1;
        res:=0;
        newres:=Pi^2/6;
        for i to n while res<>newres do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/prd`(tomult,`dev/add`(-1/i^2,
                `dev/multbyreal`(itsln,1/i))))
        od;
        if `dev/length`(newres)>n and newres[nops(newres)]<>infinity then
            RETURN(newres)
        elif op(nops(newres),newres)=infinity then
            RETURN([op(1..nops(newres)-2,newres)])
        else RETURN(newres)
        fi
    elif sig=-1 then
        sig:=evalr(Signum(coeff(`dev/lcoeff`(u[2]),I,0)));
        if sig=-1 or sig=0 then RETURN(undefined)
        elif sig=FAIL and type(u[2],constant) then ERROR(FAIL) fi;
        fact:=`dev/pow`(u,-1,n);
        itsln:=`dev/ln`(u,n);
        tomult:=1;
        res:=0;
        newres:=`dev/add`(-Pi^2/6,`dev/multbyreal`(
            `dev/pow`(itsln,2,n),-1/2));
        for i to n while res<>newres do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/prd`(tomult,`dev/add`(1/i^2,
                `dev/multbyreal`(itsln,1/i))))
        od;
        if `dev/length`(newres)>n and newres[nops(newres)]<>infinity then
            RETURN(newres)
        elif newres[nops(newres)]=infinity then
            RETURN([op(1..nops(newres)-2,newres)])
        else RETURN(newres)
        fi;
    elif sig=0 then
        init:=`dev/dilog`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            example:=[init,0];
            j:=dilog(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/dilog`

`dev/erf`:=proc(u,n)
local fact,i,x,example,side, k,ck,j, coef, init, res, sig;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        RETURN(evalc(erf(u)))
    fi;
    sig:=evalr(Signum(u[3]));
    if sig=1 then
        RETURN(`dev/prd`(u,`dev/endofdev`(`dev/pow`(u,2,n)
            ,n,map(op,[[(-1)^i/i!/(2*i+1)*2/sqrt(Pi),i]$'i'=0..n+1]))))
    elif sig=-1 then
        coef:=`dev/lcoeff`(u[2]);
        if coeff(coef,I,1)<>0 then ERROR(FAIL) fi;
        side:=evalr(Signum(coef));
        if side<>1 and side<>-1 then ERROR(FAIL) fi;
        fact:=`dev/pow`(u,-2,n);
        example:=[1,0,-1/2,1];
        ck:=-1/2;
        for i from 2 to n do
            ck:=-ck*(2*i-1)/2;
            example:=[op(example),ck,i]
        od;
        res:=`dev/prd`(`dev/pow`(u,-1,n),`dev/endofdev`(fact,n,example));
        if side=1 then
            res:=`dev/add`(1,`dev/multbyreal`(`dev/prd`(`dev/exp`(
            `dev/multbyreal`(`dev/pow`(u,2,n),-1),n),res),-1/Pi^(1/2)))
        else
            res:=`dev/add`(-1,`dev/multbyreal`(`dev/prd`(`dev/exp`(
            `dev/multbyreal`(`dev/pow`(u,2,n),-1),n),res),Pi^(-1/2)));
        fi;
        if `dev/length`(res)>n and res[nops(res)]<>infinity then 
            RETURN(res)
        elif op(nops(res),res)=infinity then
            RETURN([op(1..nops(res)-2,res)])
        else RETURN(res)
        fi;
    elif sig=0 then
        init:=`dev/erf`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            example:=[init,0];
            j:=erf(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:# `dev/erf`


##
##    Title:     STRUCTURE OF THE GENERALIZED ASYMPTOTIC EXPANSIONS
##    Created:    Mon Dec 26 11:51:50 1988
##    Author:     Bruno Salvy
##        <salvy@poly>
##    Modified:     Sun Aug 13 12:01:52 1989
##    Author:     Bruno Salvy
##    Modification: exprseq instead of product and index as first elt instead
##                  of X[index] everywhere.
##
##     A generalized asymptotic expansion is:
##  * either a list:
##      - true
##      - a sequence of couples:
##            - an infinite list (see Listinf)
##            - an asymptotic expansion corresponding to the variable in
##                 this Listinf
##  * or an asymptotic expansion.
##     An asymptotic expansion is:
##       * either undefined
##       * or a list coding a sum,
##                the first term is the index of the variable which may be an integer
##                  or a rational:
##               1  --> 1/x
##               2  --> 1/log(x)
##               3  --> 1/log(log(x)) ...
##               0  --> 1/exp(x)
##               -1 --> 1/exp(exp(x)) ...
##            the non-integer indices are determined by dev/indexify
##          the other terms encode products
##                    C*X[i]^alpha, where
##               - i is the index
##               - alpha is real
##               - C is an asymptotic expansion whose lowest monomial is
##                     smaller than X[i] or a constant term which may be 
##                     a bounded function of any X[i] 
##             This product is encoded as an exprseq of 2 elements: C,alpha
##          the last term is the power of the remainder (to appear in the O())
##              infinity means that the expansion is exact.
##
# G.J. Fee's algorithm:
`dev/cossin`:=proc (u,n)
local i, i0, inival, newu, res, co, si, still0, fact, inter, infpart, newres;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        RETURN([evalc(cos(u)),evalc(sin(u))])
    fi;
    if n=0 then RETURN([1,0]) fi;
    evalr(Signum(u[3]));
    if "=1 or "=0 then
        res:=[];
        if ""=0 then
            if not type(u[2],list) then 
                inival:=`dev/cossin`(u[2])
            else
                inival:=`dev/cossin`([op(u[2]),0,infinity],n)
            fi;
            if member(0,inival) then still0:=true else still0:=false fi;
            newu:=subsop(2=NULL,3=NULL,u)
        elif not type(u[2],list) then
            if nops(u)>3 then
                co:=[u[1],1,0];si:=[u[1],u[2],u[3]];fact:=u[2];
                for i from 2 by 2 to 2*n do
                    fact:=-fact/i*u[2];
                    co:=[op(co),fact,i*u[3]];
                    fact:=fact/(i+1)*u[2];
                    si:=[op(si),fact,(i+1)*u[3]]
                od;
                inival:=[co,si];
                still0:=false;
                newu:=subsop(2=NULL,3=NULL,u)
            else RETURN([[u[1],1,0,1,2*u[3]],u])
            fi
        else inival:=[1,0];newu:=u;still0:=true;
        fi;
        if still0 and nops(newu)>3 then
            inter:=`dev/cossin`([newu[1],newu[2],newu[3],0,infinity],
                    trunc(evalf((n+1)/newu[3])));
            if inival=[1,0] then inival:=inter
            elif inival=[0,1] then inival:=[`dev/multbyreal`(inter[2],-1),
                inter[1]]
            elif inival=[-1,0] then
                inival:=[`dev/multbyreal`(inter[1],-1),
                    `dev/multbyreal`(inter[2],-1)]
            elif inival=[0,-1] then    
                inival:=[inter[2],`dev/multbyreal`(inter[1],-1)]
            fi;
            newu:=subsop(2=NULL,3=NULL,newu);
        fi;
        i0:=newu[3];
        if newu[nops(newu)]=infinity then nops(newu)-3 else nops(newu)-1 fi;
        newres:=inival;
        for i from 2 by 2 to "" while newres<>res do
            res:=newres;
            inter:=`dev/cossin`([newu[1],newu[i],newu[i+1],0,infinity],
                trunc(evalf((n+1)*i0/newu[i+1]/2)));
            newres:=[`dev/add`(`dev/prd`(res[1],inter[1]),`dev/multbyreal`(
                    `dev/prd`(res[2],inter[2]),-1)),
             `dev/add`(`dev/prd`(res[1],inter[2]),`dev/prd`(res[2],inter[1]))]
        od;
        if res=[] then RETURN(inival) else RETURN(newres) fi;
    elif "=-1 then
        for i from 5 to nops(u) while member(evalr(Signum(u[i])),{-1,0})do od;
        infpart:=`dev/instanc`([op(1..i-2,u)]);
        if nops(u)>=i and u[i]<>infinity then
            inter:=`dev/cossin`([u[1],op(i-1..nops(u),u)],n);
            RETURN([`dev/add`(`dev/multbyreal`(inter[1],cos(infpart)),
                          `dev/multbyreal`(inter[2],-sin(infpart))),
             `dev/add`(`dev/multbyreal`(inter[1], sin(infpart)),
                          `dev/multbyreal`(inter[2], cos(infpart)))])
        else RETURN([cos(infpart),sin(infpart)])
        fi
    else ERROR(FAIL)
    fi
end: # `dev/cossin`


`dev/cos`:=proc(u,n)
    RETURN(`dev/cossin`(u,n)[1])
end:


`dev/sin`:=proc(u,n)
    RETURN(`dev/cossin`(u,n)[2])
end:


`dev/tan`:=proc(u,n)
local fact, i, example, expon, kfact, inter, init;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(tan(u));
        if init=lasterror or has(init,infinity) then RETURN(undefined)
        elif testeq(init)=true then RETURN(0)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,1/3,1,2/15,2,17/315,3];
        expon:=256;
        kfact:=-40320;
        for i from 5 to n+1 do
            expon:=4*expon;
            kfact:=-kfact*2*i*(2*i-1);
            example:=[op(example),expon*(expon-1)/kfact*bernoulli(2*i),i-1]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(fact,n,example)))
    elif "=-1 then RETURN(undefined)
    elif "=0 then
        init:=`dev/tan`(u[2],n);
        if init=undefined then
            `dev/cot`(`dev/add`(Pi/2,`dev/multbyreal`(u,-1)),n)
        elif `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init)
        else
            inter:=`dev/tan`(subsop(2=NULL,3=NULL,u),n);
            RETURN(`dev/prd`(`dev/add`(inter,init),`dev/pow`(`dev/add`(1,
                        `dev/prd`(inter,`dev/multbyreal`(init,-1))),-1,n)))
        fi
    else ERROR(FAIL)
    fi
end:


`dev/cot`:=proc(u,n)
local fact,i, example, kfact, init, inter;
    if not type(u,list) then
        init:=traperror(cot(u));
        if init=lasterror or has(init,infinity) then RETURN(undefined)
        elif testeq(init)=true then RETURN(0)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[-1/3,0,-1/45,1,-2/945,2];
        kfact:=-4/45;
        for i from 4 to n do
            kfact:=-kfact*2/i/(2*i-1);
            example:=[op(example),kfact*bernoulli(2*i),i-1]
        od;
        RETURN(`dev/add`(`dev/pow`(u,-1,n),`dev/prd`(u,`dev/endofdev`(fact,
            n-1,example))))
    elif "=-1 then RETURN(undefined)
    elif "=0 then
        init:=`dev/cot`(u[2],n);
        if init=undefined then 
            `dev/tan`(`dev/add`(Pi/2,`dev/multbyreal`(u,-1)),n)
        elif `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            inter:=`dev/cot`(subsop(2=NULL,3=NULL,u),n);
            RETURN(`dev/prd`(`dev/add`(`dev/prd`(init,inter),-1),
                        `dev/pow`(`dev/add`(init,inter),-1,n)))
        fi
    else ERROR(FAIL)
    fi
end:


`dev/sec`:=proc (u,n)
local fact,i, example, kfact, init;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(sec(u));
        if init=lasterror or has(init,infinity) then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,1/2,1,5/24,2,61/720,3];
        kfact:=-720;
        for i from 4 to n do
            kfact:=-kfact*2*i*(2*i-1);
            example:=[op(example),euler(2*i)/kfact,i]
        od;
        RETURN(`dev/endofdev`(fact,n,example))
    elif "=-1 then RETURN(undefined)
    elif "=0 then
        RETURN(`dev/pow`(`dev/cossin`(u,n)[1],-1,n))
    else ERROR(FAIL)
    fi
end: # `dev/sec`


`dev/csc`:=proc(u,n)
local fact,i, init, newres, res, tomult;
    if not type(u,list) then
        init:=traperror(csc(u));
        if init=lasterror or has(init,infinity) then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        tomult:=u;
        res:=0;
        newres:=`dev/add`(`dev/pow`(u,-1,n),`dev/multbyreal`(u,1/6));
        for i from 2 to n+1 while newres<>res do    
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/multbyreal`(tomult,
                (-1)^(i-1)*2*(2^(2*i-1)-1)*bernoulli(2*i)/(2*i)!))
        od;
        RETURN(`dev/reduce`(newres,n))
    elif "=-1 then RETURN(undefined)
    elif "=0 then
        RETURN(`dev/pow`(`dev/cossin`(u,n)[2],-1,n))
    else ERROR(FAIL)
    fi
end:


`dev/arccos`:=proc(u,n)
    `dev/add`(Pi/2,`dev/multbyreal`(`dev/arcsin`(u,n),-1))
end:


`dev/arcsin`:=proc(u,n)
local fact,i,k,x,example,j,kfact, init;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        RETURN(evalc(arcsin(u)))
    fi;
    evalr(Signum(u[3]));;
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,1/6,1,3/40,2];
        kfact:=3/8;
        for i from 3 to n do
            kfact:=kfact*(2*i-1)/2/i;
            example:=[op(example),kfact/(2*i+1),i]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(fact,n,example)))
    elif "=-1 then RETURN(undefined)
    elif "=0 then
        init:=`dev/arcsin`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then
            RETURN(init) fi;
        if not type(u[2],realcons) then ERROR(FAIL) fi;
        evalr(Signum(u[2]-1));
        if "=1 then RETURN(undefined)
        elif "=0 then
            fact:=subsop(2=NULL,3=NULL,u);
            example:=[1,0,-1/12,1];
            kfact:=-1/4;
            for i from 2 to n-1 do    
                kfact:=-kfact*(2*i-1)/4/i;
                example:=[op(example),kfact/(2*i+1),i]
            od;
            RETURN(`dev/add`(Pi/2,`dev/multbyreal`(`dev/prd`(`dev/pow`(
                `dev/multbyreal`(fact,-1),1/2,n-1),
                `dev/endofdev`(fact,n-1,example)),-2^(1/2))))
        elif "=-1 then
            evalr(Signum(-1-u[2]));
            if "=1 then RETURN(undefined)
            elif "=0 then
                fact:=subsop(2=NULL,3=NULL,u);
                example:=[1,0,1/12,1];
                kfact:=1/4;
                for i from 2 to n-1 do    
                    kfact:=kfact*(2*i-1)/4/i;
                    example:=[op(example),kfact/(2*i+1),i]
                od;
                RETURN(`dev/add`(-Pi/2,`dev/multbyreal`(`dev/prd`(`dev/pow`(
                    fact,1/2,n-1),`dev/endofdev`(fact,n-1,example)),
                    -2^(1/2))))
            elif "=-1 then
                init:=`dev/arcsin`(u[2],n);
                if `dev/length`(init)>n and init[nops(init)]<>infinity then
                    RETURN(init)
                else
                    example:=[init,0];
                    j:=arcsin(x);
                    k:=1;
                    for i to n do
                        j:=diff(j,x);
                        k:=k/i;
                        example:=[op(example),subs(x=u[2],j)*k,i]
                    od;
                    fact:=subsop(2=NULL,3=NULL,u);
                    RETURN(`dev/endofdev`(fact,n,example))
                fi
            else ERROR(FAIL)
            fi
        else ERROR(FAIL)
        fi
    else ERROR(FAIL)
    fi
end:


`dev/arctan`:=proc(u,n)
local fact,i,x, example, invu, init, j, k;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        RETURN(evalc(arctan(u)))
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        RETURN(`dev/prd`(u,`dev/endofdev`(fact,n,map(op,[[(-1)^i/(2*i+1),i]$
            i=0..n+1]))))
    elif "=-1 then
        `dev/sign`(u[2]);
        if "=FAIL then ERROR(FAIL)
        elif "=1 then
            fact:=`dev/pow`(u,-2,n-1);
            RETURN(`dev/add`(Pi/2,`dev/prd`(`dev/pow`(u,-1,n-1),`dev/endofdev`(
                fact,n-1,map(op,[[(-1)^(i+1)/(2*i+1),i]$i=0..n-1])))))
        elif "=-1 then
            invu:=`dev/pow`(u,-1,n-1);
            fact:=`dev/pow`(invu,2,n-1);
            RETURN(`dev/add`(-Pi/2,`dev/prd`(invu,`dev/endofdev`(
                fact,n,map(op,[[(-1)^i/(2*i+1),i]$i=0..n])))))
        else ERROR(FAIL)
        fi;
    elif "=0 then
        init:=`dev/arctan`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then 
            RETURN(init)
        else
            example:=[init,0];
            j:=arctan(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else ERROR(FAIL)
    fi
end:


`dev/arccot`:=proc (u,n)
    `dev/add`(Pi/2,`dev/multbyreal`(`dev/arctan`(u,n),-1))
end: # `dev/arccot`


`dev/arccsc`:=proc(u,n)
local fact, i, example, kfact, init;
    if u=undefined then RETURN(undefined) fi;
    if not type(u,list) then
        init:=traperror(arccsc(u));
        if init=lasterror or has(init,infinity) then
            RETURN(undefined)
        else
            RETURN(init)
        fi
    fi;
    evalr(Signum(u[3]));
    if "=-1 then
        fact:=`dev/pow`(u,-2,n);
        example:=[1,0,1/6,1];
        kfact:=1/2;
        for i from 2 to n do
            kfact:=kfact*(2*i-1)/2/i;
            example:=[op(example),kfact/(2*i+1),i]
        od;
        RETURN(`dev/prd`(`dev/pow`(u,-1,n),`dev/endofdev`(fact,n,example)))
    elif "=1 then RETURN(undefined)
    elif "=0 then
        RETURN(`dev/arcsin`(`dev/pow`(u,-1,n),n))
    else ERROR(FAIL)
    fi
end: # `dev/arccsc`


`dev/arcsec`:=proc (u,n)
    `dev/add`(Pi/2,`dev/multbyreal`(`dev/arccsc`(u,max(2,n-1)),-1))
end: # `dev/arcsec`


`dev/sinh`:=proc (u,n)
local fact, i, example, ifact, init;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        RETURN(evalc(sinh(u)))
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,1/6,1,1/120,2];
        ifact:=120;
        for i from 4 to n+1 do
            ifact:=ifact*(i-1)*i;
            example:=[op(example),1/ifact,i-1]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(fact,n,example)))
    elif "=-1 then
        evalr(Signum(`dev/lcoeff`(u)));
        if "=1 then
            init:=`dev/exp`(u,n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,1/2))
            else
                RETURN(`dev/multbyreal`(`dev/add`(init,`dev/multbyreal`(
                    `dev/pow`(init,-1,n),-1)),1/2))
            fi
        elif "=-1 then
            init:=`dev/exp`(`dev/multbyreal`(u,-1),n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,-1/2))
            else
                RETURN(`dev/multbyreal`(`dev/add`(`dev/multbyreal`(init,-1),
                    `dev/pow`(init,-1,n)),1/2))
            fi
        else ERROR(FAIL)
        fi
    elif "=0 then # this should be made more efficient either by the same
                      # technique as for sin, or by the exponential def, or 
                      # by taylor series.
        RETURN(`dev/add`(`dev/prd`(`dev/sinh`(u[2],n),
            `dev/cosh`(subsop(2=NULL,3=NULL,u),n)),`dev/prd`(
            `dev/cosh`(u[2],n),`dev/sinh`(subsop(2=NULL,3=NULL,u),n))))
    else
        ERROR(FAIL)
    fi;
end: # `dev/sinh`


`dev/cosh`:=proc (u,n)
local fact, i, ifact, example, init;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then RETURN(evalc(cosh(u)))
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,1/2,1,1/24,2];
        ifact:=24;
        for i from 3 to n do
            ifact:=ifact*(2*i-1)*i*2;
            example:=[op(example),1/ifact,i]
        od;
        RETURN(`dev/endofdev`(fact,n,example))
    elif "=-1 then
        evalr(Signum(`dev/lcoeff`(u)));
        if "=1 then
            init:=`dev/exp`(u,n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,1/2))
            else
                RETURN(`dev/multbyreal`(`dev/add`(init,`dev/pow`(init
                    ,-1,n)),1/2))
            fi
        elif "=-1 then
            init:=`dev/exp`(`dev/multbyreal`(u,-1),n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,1/2))
            else
                RETURN(`dev/multbyreal`(`dev/add`(init,`dev/pow`(init,-1)),1/2))
            fi
        fi
    elif "=0 then # same comment as above
        RETURN(`dev/add`(`dev/prd`(`dev/cosh`(u[2],n),
            `dev/cosh`(subsop(2=NULL,3=NULL,u),n)),`dev/prd`(
            `dev/sinh`(u[2],n),`dev/sinh`(subsop(2=NULL,3=NULL,u),n))))
    else
        ERROR(FAIL)
    fi;
end: # `dev/cosh`


`dev/tanh`:=proc (u,n)
local fact, i, ifact, expon, example, init, inter;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then RETURN(evalc(tanh(u)))
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,-1/3,1,2/15,2,-17/315,3];
        ifact:=40320;
        expon:=256;
        for i from 4 to n do
            ifact:=ifact*(2*i+1)*2*(i+1);
            expon:=4*expon;
            example:=[op(example),expon*(expon-1)*bernoulli(2*i+2)/ifact,i]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(fact,n+1,example)))
    elif "=-1 then
        evalr(Signum(`dev/lcoeff`(u)));
        if "=1 then
            RETURN(`dev/endofdev`(`dev/exp`(`dev/prd`(u,-2),n),n,
                [1,0,op(map(op,[[-2,2*i-1,2,2*i]$i=1..iquo(n,2)+1]))]))
        else
            RETURN(`dev/endofdev`(`dev/exp`(`dev/prd`(u,2),n),n,
                [-1,0,op(map(op,[[2,2*i-1,-2,2*i]$i=1..iquo(n,2)+1]))]))
        fi
    elif "=0 then # should be made more efficient.
        init:=`dev/tanh`(u[2],n); 
        inter:=`dev/tanh`(subsop(2=NULL,3=NULL,u),n);
        RETURN(`dev/prd`(`dev/add`(inter,init),`dev/pow`(`dev/add`(1,
            `dev/prd`(inter,init)),-1,n)))
    else
        ERROR(FAIL)
    fi;
end: # `dev/tanh`


`dev/coth`:=proc (u,n)
local fact, i, example, ifact, init, inter;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        init:=traperror(coth(u[1]));
        if init=lasterror then 
            RETURN(undefined)
        else
            RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1/3,0,-1/45,1,2/945,2];
        ifact:=4/45;
        for i from 3 to n-1 do
            ifact:=ifact*2/(2*i+1)/(i+1);
            example:=[op(example),ifact*bernoulli(2*i+2),i]
        od;
        RETURN(`dev/add`(`dev/pow`(u,-1,n),`dev/prd`(u,`dev/endofdev`(fact,
            n-1,example))))
    elif "=-1 then
        evalr(Signum(`dev/lcoeff`(u)));
        if "=1 then
            RETURN(`dev/endofdev`(`dev/exp`(`dev/multbyreal`(u,-1),n),n,
                [1,0,op(map(op,[[2,i]$i=1..n]))]))
        else
            RETURN(`dev/endofdev`(`dev/exp`(u,n),n,[-1,0,op(map(op,
                [[-2,i]$i=1..n]))]))
        fi
    elif "=0 then # same comment as above
        init:=`dev/coth`(u[2],n);
        inter:=`dev/coth`(subsop(2=NULL,3=NULL,u),n);
        RETURN(`dev/prd`(`dev/add`(1,`dev/prd`(init,inter)),
            `dev/pow`(`dev/add`(init,inter),-1,n)))
    else
        ERROR(FAIL)
    fi;
end: # `dev/coth`


`dev/sech`:=proc (u,n)
local fact, i, example, ifact, init;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then RETURN(evalc(sech(u)))
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        fact:=`dev/pow`(u,2,n);
        example:=[1,0,-1/2,1,5/24,2,-61/720,3];
        ifact:=720;
        for i from 4 to n do
            ifact:=ifact*2*i*(2*i-1);
            example:=[op(example),euler(2*i)/ifact,i]
        od;
        RETURN(`dev/endofdev`(fact,n,example))
    elif "=-1 then
        evalr(Signum(`dev/lcoeff`(u)));
        if "=1 then
            init:=`dev/exp`(`dev/multbyreal`(u,-1),n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,2))
            else
                RETURN(`dev/multbyreal`(`dev/prd`(init,`dev/endofdev`(`dev/pow`(
                    init,2,n),n,op(map(op,[[1,i]$i=0..n])))),2))
            fi
        else
            init:=`dev/exp`(u,n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,-2))
            else
                RETURN(`dev/multbyreal`(`dev/prd`(init,`dev/endofdev`(`dev/pow`(
                    init,2,n),n,op(map(op,[[1,i]$i=0..n])))),-2))
            fi
        fi
    elif "=0 then
        `dev/pow`(`dev/cosh`(u,n),-1,n)
    else
        ERROR(FAIL)
    fi;
end: # `dev/sech`


`dev/csch`:=proc (u,n)
local i, example, expon, ifact, init;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        init:=traperror(csch(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        example:=[-1/6,0,7/360,1,-31/15120,2];
        ifact:=720;
        expon:=32;
        for i from 3 to n-1 do    
            ifact:=ifact*2*(i+1)*(2*i+1);
            expon:=expon*4;
            example:=[op(example),2*(expon-1)/ifact*bernoulli(2*i+2),i]
        od;
        RETURN(`dev/add`(`dev/pow`(u,-1,n),`dev/prd`(u,`dev/endofdev`(
            `dev/pow`(u,2,n-1),n-1,example))))
    elif "=-1 then
        evalr(Signum(`dev/lcoeff`(u)));
        if "=1 then
            init:=`dev/exp`(`dev/multbyreal`(u,-1),n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,2))
            else
                RETURN(`dev/multbyreal`(`dev/prd`(init,`dev/endofdev`(`dev/pow`(
                    init,2,n),n,map(op,[[1,i]$i=0..n]))),2))
            fi
        else
            init:=`dev/exp`(u,n);
            if `dev/length`(init)>n and init[nops(init)]<>infinity then
                RETURN(`dev/multbyreal`(init,-2))
            else
                RETURN(`dev/multbyreal`(`dev/prd`(init,`dev/endofdev`(`dev/pow`(
                    init,2,n),n,map(op,[[1,i]$i=0..n]))),-2))
            fi
        fi;
    elif "=0 then
        RETURN(`dev/pow`(`dev/sinh`(u,n),-1,n))
    else
        ERROR(FAIL)
    fi;
end: # `dev/csch`


`dev/arcsinh`:=proc (u,n)
local fact, i, side, example, x, ifact, j, k, coef,init, newres, res, tomult;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then RETURN(evalc(arcsinh(u)))
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        example:=[1,0,-1/6,1,3/40,2,-5/112,3];
        ifact:=-5/16;
        for i from 4 to n do
            ifact:=-ifact*(2*i-1)/2/i;
            example:=[op(example),ifact/(2*i+1),i]
        od;
        RETURN(`dev/prd`(u,`dev/endofdev`(`dev/pow`(u,2,n),n,example)))
    elif "=-1 then
        coef:=coeff(`dev/lcoeff`(u),I,0);
        if type(coef,constant) then
            evalr(Signum(coef));
            if "=-1 or "=1 then side:=" else ERROR(FAIL) fi
        else
            # assume the user wants +infinity
            side:=1
        fi;
        fact:=`dev/pow`(u,-2,n);
        res:=0;
        tomult:=1;
        newres:=`dev/multbyreal`(`dev/ln`(`dev/multbyreal`(u,2*side),n),side);
        for i to n while res<>newres do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/multbyreal`(tomult,(-1)^(i+1)*
                product(2*'k'-1,'k'=1..i)/product(2*'k','k'=1..i)/2/i))
        od;
        RETURN(newres)
    elif "=0 then
        init:=`dev/arcsinh`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then RETURN(init)
        else
            example:=[init,0];
            j:=arcsinh(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else
        ERROR(FAIL)
    fi;
end: # `dev/arcsinh`


`dev/arccosh`:=proc (u,n)
local fact, i, example, x, j, k, coef, init, newres, res, tomult;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        init:=traperror(arccosh(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        RETURN(undefined)
    elif "=-1 then
        coef:=coeff(`dev/lcoeff`(u),I,0);
        if type(coef,constant) then
            evalr(Signum(coef));
            if "=-1 then RETURN(undefined)
            elif "=FAIL then ERROR(FAIL)
            fi
        else
            # assume the user wants +infinity
        fi;
        fact:=`dev/pow`(u,-2,n);
        res:=0;
        tomult:=1;
        newres:=`dev/ln`(`dev/multbyreal`(u,2),n);
        for i to n while res<>newres do
            res:=newres;
            tomult:=`dev/prd`(tomult,fact);
            newres:=`dev/add`(res,`dev/multbyreal`(tomult,-1*product(2*'k'-1,
                'k'=1..i)/product(2*'k','k'=1..i)/2/i))
        od;
        RETURN(newres)
    elif "=0 then
        init:=`dev/arccosh`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then RETURN(init)
        else
            example:=[init,0];
            j:=arccosh(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else
        ERROR(FAIL)
    fi;
end: # `dev/arccosh`


`dev/arctanh`:=proc (u,n)
local fact, i, example, x, j, k, init;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        init:=traperror(arctanh(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=1 then
        RETURN(`dev/prd`(u,`dev/endofdev`(`dev/pow`(u,2,n),n,map(op,
            [[1/(2*i+1),i]$i=0..n]))))
    elif "=-1 then
        RETURN(undefined)
    elif "=0 then
        init:=`dev/arctanh`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then RETURN(init)
        else
            example:=[init,0];
            j:=arctanh(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else
        ERROR(FAIL)
    fi;
end: # `dev/arctanh`


`dev/arccoth`:=proc (u,n)
local fact, i, x, example, j, k, init, invu;
    if u=undefined then
        RETURN(undefined)
    fi;
    if not type(u,list) then
        init:=traperror(arccoth(u));
        if init=lasterror then RETURN(undefined)
        else RETURN(evalc(init))
        fi
    fi;
    evalr(Signum(u[3]));
    if "=-1 then
        invu:=`dev/pow`(u,-1,n);
        RETURN(`dev/prd`(invu,`dev/endofdev`(`dev/pow`(invu,2,n),n,map(op,
            [[1/(2*i+1),i]$i=0..n]))))
    elif "=1 then
        RETURN(undefined)
    elif "=0 then
        init:=`dev/arccoth`(u[2],n);
        if `dev/length`(init)>n and init[nops(init)]<>infinity then RETURN(init)
        else
            example:=[init,0];
            j:=arccoth(x);
            k:=1;
            for i to n do
                j:=diff(j,x);
                k:=k/i;
                example:=[op(example),subs(x=u[2],j)*k,i]
            od;
            fact:=subsop(2=NULL,3=NULL,u);
            RETURN(`dev/endofdev`(fact,n,example))
        fi
    else
        ERROR(FAIL)
    fi;
end: # `dev/arccoth`


`dev/arcsech`:=proc (u,n)
    `dev/arccosh`(`dev/pow`(u,-1,n),n)
end: # `dev/arcsech`


`dev/arccsch`:=proc (u,n)
    `dev/arcsinh`(`dev/pow`(u,-1,n),n)
end: # `dev/arccsch`

#save `gdev.m`;
#quit
