# SINGLINK
# Use the computer algebra system Singular to compute a Groebner basis.
# 'P' is the characteristic of the ground field.
# If P=0 or missing, the characteristic is zero indeed!
# If P=-1 then the maximum characteristic 32003 is taken.
# 'minpol' can be a minimal polynomial defining an algebraic extension of the
# prime field.
# 'tord' is a Singular ordering string

singlink:=proc(I,P,tord)
    local i,j,n,m,sub,c,path,vars,F,pars,reorder,ord,p,mipo,alg,ele;
    
    F:=map(expand,I);
    vars:=indets(F);
    if P>0 then p:=P else p:=0 fi;
    
    path:=`Trans`;
    if assigned(pathname) then path:=cat(pathname,path) fi;
    if system(`mkdir `.path)<>0 then
      ERROR(`Couldn't make the Transfer-directory`)
    fi;

    # produce input for Singular ...
    gc(0);                  # Avoid that garbage-collection stuff is babbled!
    writeto(cat(path,`/In`));
    
    # Define the ring (with term order)
    lprint(`ring R =`);
    lprint(``.p.`,`);
    lprint(`(x(1..`.(nops(vars)).`)),`);
    lprint(`(`.cat(tord).`);`));
    
    # Define the ideal ...
    lprint(`ideal I =`);
    for i to nops(F) do
        if i>1 then lprint(`,`) fi;
        ele:=subs([seq(vars[j]=x(j), j=1..nops(vars))],F[i]);
        if type(ele,monomial) then lprint(ele)
        else   # split into summands, otherwise line might get chopped!
            lprint(op(1,ele));
            for j from 2 to nops(ele) do
                lprint(``+op(j,ele))
            od
        fi
    od;
    lprint(`;`);
    
    lprint(`short=0;`);
    lprint(`ideal b = std(I);`);
    lprint(`write("`.path.`/Out","[");`);
    lprint(`write("`.path.`/Out",b);`);
    lprint(`write("`.path.`/Out","];");`);
    writeto(terminal);
    
    # Call Singular ...
    system(`Singular < `.path.`/In > `.path.`/temp`);
    if "<>0 then
        system(`'rm' -r `.path);
        ERROR(`Something went wrong while executing Singular`)
    fi;
    
    # Retrieve the results ...
    read(cat(path,`/Out`));
    F:=";
    system(`'rm' -r `.path);
    F:=subs([seq(x(i)=vars[i],i=1..nops(vars))],F);
    F:=map(expand,F);
    F
end: