/**************************************** * * Computer Algebra System SINGULAR * * ****************************************/ /* * ABSTRACT: ascii links (standard) */ #include "kernel/mod2.h" #include "misc/options.h" #include "Singular/tok.h" #include "Singular/subexpr.h" #include "Singular/ipshell.h" #include "Singular/ipid.h" #include "Singular/fevoices.h" #include "kernel/oswrapper/feread.h" #include "Singular/ipshell.h" #include "Singular/links/silink.h" /* declarations */ static BOOLEAN DumpAscii(FILE *fd, idhdl h,char ***list_of_libs); static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h,char ***list_of_libs); static const char* GetIdString(idhdl h); static int DumpRhs(FILE *fd, idhdl h); static BOOLEAN DumpQring(FILE *fd, idhdl h); static BOOLEAN DumpNCring(FILE *fd, idhdl h); static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl); static BOOLEAN CollectLibs(char *name, char ***list_of_libs); //static BOOLEAN DumpLibs(FILE *fd, char ***list_of_libs); EXTERN_VAR si_link_extension si_link_root; /* =============== ASCII ============================================= */ BOOLEAN slOpenAscii(si_link l, short flag, leftv /*h*/) { const char *mode; if (flag & SI_LINK_OPEN) { if (l->mode[0] != '\0' && (strcmp(l->mode, "r") == 0)) flag = SI_LINK_READ; else flag = SI_LINK_WRITE; } if (flag == SI_LINK_READ) mode = "r"; else if (strcmp(l->mode, "w") == 0) mode = "w"; else mode = "a"; if (l->name[0] == '\0') { // stdin or stdout if (flag == SI_LINK_READ) { l->data = (void *) stdin; mode = "r"; } else { l->data = (void *) stdout; mode = "a"; } } else { // normal ascii link to a file FILE *outfile; char *filename=l->name; if(filename[0]=='>') { if (filename[1]=='>') { filename+=2; mode = "a"; } else { filename++; mode="w"; } } outfile=myfopen(filename,mode); if (outfile!=NULL) l->data = (void *) outfile; else return TRUE; } omFree(l->mode); l->mode = omStrDup(mode); SI_LINK_SET_OPEN_P(l, flag); return FALSE; } BOOLEAN slCloseAscii(si_link l) { SI_LINK_SET_CLOSE_P(l); if (l->name[0] != '\0') { return (fclose((FILE *)l->data)!=0); } return FALSE; } leftv slReadAscii2(si_link l, leftv pr) { FILE * fp=(FILE *)l->data; char * buf=NULL; if (fp!=NULL && l->name[0] != '\0') { fseek(fp,0L,SEEK_END); long len=ftell(fp); if (len<0) len=0; fseek(fp,0L,SEEK_SET); buf=(char *)omAlloc((int)len+1); if (BVERBOSE(V_READING)) Print("//Reading %ld chars\n",len); if (len>0) myfread( buf, len, 1, fp); buf[len]='\0'; } else { if (pr->Typ()==STRING_CMD) { buf=(char *)omAlloc(80); fe_fgets_stdin((char *)pr->Data(),buf,80); } else { WerrorS("read(,) expected"); buf=omStrDup(""); } } leftv v=(leftv)omAlloc0Bin(sleftv_bin); v->rtyp=STRING_CMD; v->data=buf; return v; } leftv slReadAscii(si_link l) { sleftv tmp; memset(&tmp,0,sizeof(sleftv)); tmp.rtyp=STRING_CMD; tmp.data=(void*) "? "; return slReadAscii2(l,&tmp); } BOOLEAN slWriteAscii(si_link l, leftv v) { FILE *outfile=(FILE *)l->data; BOOLEAN err=FALSE; char *s; while (v!=NULL) { switch(v->Typ()) { case IDEAL_CMD: case MODUL_CMD: case MATRIX_CMD: { ideal I=(ideal)v->Data(); for(int i=0;im[i]); fwrite(s,strlen(s),1,outfile); omFree(s); if (iData(); for(int i=0;inr;i++) { char *s=l->m[i].String(); fwrite(s,strlen(s),1,outfile); omFree(s); if (i!=l->nr-1) fputc(',',outfile); fputc('\n',outfile); } break; } #endif default: s = v->String(); // free v ?? if (s!=NULL) { fputs(s,outfile); fputc('\n',outfile); omFree((ADDRESS)s); } else { WerrorS("cannot convert to string"); err=TRUE; } } v = v->next; } fflush(outfile); return err; } const char* slStatusAscii(si_link l, const char* request) { if (strcmp(request, "read") == 0) { if (SI_LINK_R_OPEN_P(l)) return "ready"; else return "not ready"; } else if (strcmp(request, "write") == 0) { if (SI_LINK_W_OPEN_P(l)) return "ready"; else return "not ready"; } else return "unknown status request"; } /*------------------ Dumping in Ascii format -----------------------*/ BOOLEAN slDumpAscii(si_link l) { FILE *fd = (FILE *) l->data; idhdl h = IDROOT, rh = currRingHdl; char **list_of_libs=NULL; BOOLEAN status = DumpAscii(fd, h, &list_of_libs); if (! status ) status = DumpAsciiMaps(fd, h, NULL); if (currRingHdl != rh) rSetHdl(rh); fprintf(fd, "option(set, intvec(%d, %d));\n", si_opt_1, si_opt_2); char **p=list_of_libs; if (p!=NULL) { while((*p!=NULL) && (*p!=(char*)1)) { fprintf(fd,"load(\"%s\",\"try\");\n",*p); p++; } omFree(list_of_libs); } fputs("RETURN();\n",fd); fflush(fd); return status; } // we do that recursively, to dump ids in the the order in which they // were actually defined static BOOLEAN DumpAscii(FILE *fd, idhdl h, char ***list_of_libs) { if (h == NULL) return FALSE; if (DumpAscii(fd, IDNEXT(h),list_of_libs)) return TRUE; // need to set the ring before writing it, otherwise we get in // trouble with minpoly if (IDTYP(h) == RING_CMD) rSetHdl(h); if (DumpAsciiIdhdl(fd, h,list_of_libs)) return TRUE; if (IDTYP(h) == RING_CMD) return DumpAscii(fd, IDRING(h)->idroot,list_of_libs); else return FALSE; } static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl) { if (h == NULL) return FALSE; if (DumpAsciiMaps(fd, IDNEXT(h), rhdl)) return TRUE; if (IDTYP(h) == RING_CMD) return DumpAsciiMaps(fd, IDRING(h)->idroot, h); else if (IDTYP(h) == MAP_CMD) { char *rhs; rSetHdl(rhdl); rhs = h->String(); if (fprintf(fd, "setring %s;\n", IDID(rhdl)) == EOF) return TRUE; if (fprintf(fd, "%s %s = %s, %s;\n", Tok2Cmdname(MAP_CMD), IDID(h), IDMAP(h)->preimage, rhs) == EOF) { omFree(rhs); return TRUE; } else { omFree(rhs); return FALSE; } } else return FALSE; } static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h, char ***list_of_libs) { const char *type_str = GetIdString(h); int type_id = IDTYP(h); if (type_id == PACKAGE_CMD) { if (strcmp(IDID(h),"Top")==0) return FALSE; // do not dump "Top" if (IDPACKAGE(h)->language==LANG_SINGULAR) return FALSE; if (IDPACKAGE(h)->language==LANG_MIX) return FALSE; } if (type_id == CRING_CMD) { // do not dump the default CRINGs: if (strcmp(IDID(h),"QQ")==0) return FALSE; if (strcmp(IDID(h),"ZZ")==0) return FALSE; #ifdef SINGULAR_4_2 if (strcmp(IDID(h),"AE")==0) return FALSE; if (strcmp(IDID(h),"QAE")==0) return FALSE; #endif } // we do not throw an error if a wrong type was attempted to be dumped if (type_str == NULL) return FALSE; // handle nc-rings separately if ((type_id == RING_CMD)&&(rIsNCRing(IDRING(h)))) return DumpNCring(fd,h); // handle qrings separately if ((type_id == RING_CMD)&&(IDRING(h)->qideal!=NULL)) return DumpQring(fd, h); // C-proc not to be dumped if ((type_id == PROC_CMD) && (IDPROC(h)->language == LANG_C)) return FALSE; // handle libraries if ((type_id == PROC_CMD) && (IDPROC(h)->language == LANG_SINGULAR) && (IDPROC(h)->libname!=NULL)) return CollectLibs(IDPROC(h)->libname,list_of_libs); // put type and name if (fprintf(fd, "%s %s", type_str, IDID(h)) == EOF) return TRUE; // for matricies, append the dimension if (type_id == MATRIX_CMD) { ideal id = IDIDEAL(h); if (fprintf(fd, "[%d][%d]", id->nrows, id->ncols)== EOF) return TRUE; } else if (type_id == INTMAT_CMD) { if (fprintf(fd, "[%d][%d]", IDINTVEC(h)->rows(), IDINTVEC(h)->cols()) == EOF) return TRUE; } else if (type_id == SMATRIX_CMD) { ideal id = IDIDEAL(h); if (fprintf(fd, "[%d][%d]", (int)id->rank, IDELEMS(id))== EOF) return TRUE; } if (type_id == PACKAGE_CMD) { return (fputs(";\n",fd) == EOF); } // write the equal sign if (fputs(" = ",fd) == EOF) return TRUE; // and the right hand side if (DumpRhs(fd, h) == EOF) return TRUE; // semicolon und tschuess if (fputs(";\n",fd) == EOF) return TRUE; return FALSE; } static const char* GetIdString(idhdl h) { int type = IDTYP(h); switch(type) { case LIST_CMD: //{ // // // lists l = IDLIST(h); // int i, nl = l->nr + 1; // // for (i=0; im[i])) == NULL) return NULL; // break; //} case CRING_CMD: #ifdef SINGULAR_4_2 case CNUMBER_CMD: case CMATRIX_CMD: #endif case BIGINT_CMD: case PACKAGE_CMD: case INT_CMD: case INTVEC_CMD: case INTMAT_CMD: case STRING_CMD: case RING_CMD: case QRING_CMD: case PROC_CMD: case NUMBER_CMD: case POLY_CMD: case IDEAL_CMD: case VECTOR_CMD: case MODUL_CMD: case MATRIX_CMD: case SMATRIX_CMD: return Tok2Cmdname(type); case MAP_CMD: case LINK_CMD: return NULL; default: Warn("Error dump data of type %s", Tok2Cmdname(IDTYP(h))); return NULL; } } static BOOLEAN DumpNCring(FILE *fd, idhdl h) { char *ring_str = h->String(); ring r=IDRING(h); if (rIsPluralRing(r)) { if (fprintf(fd, "ring temp_ring = %s;\n", ring_str) == EOF) return TRUE; if (fprintf(fd, "ideal temp_C = %s;\n", iiStringMatrix((matrix) r->GetNC()->C, 2, r, n_GetChar(r->cf))) == EOF) return TRUE; if (fprintf(fd, "ideal temp_D = %s;\n", iiStringMatrix((matrix) r->GetNC()->D, 2, r, n_GetChar(r->cf))) == EOF) return TRUE; if (fprintf(fd, "def %s = nc_algebra(temp_C,temp_D);\n",IDID(h)) == EOF) return TRUE; if (fputs("kill temp_ring;\n",fd) == EOF) return TRUE; } if (rIsLPRing(r)) { //if (fprintf(fd, "ring %s = %s;\n", IDID(h), ring_str) == EOF) return TRUE; //if (fprintf(fd, "attrib(%s,\"isLetterplaceRing\",%d);\n",IDID(h),r->isLPring) ==EOF) return TRUE; Warn("cannot write LP ring %s",IDID(h)); return TRUE; } omFree(ring_str); return FALSE; } static BOOLEAN DumpQring(FILE *fd, idhdl h) { char *ring_str = h->String(); ring r=IDRING(h); if (fprintf(fd, "ring temp_ring = %s;\n", ring_str) == EOF) return TRUE; if (fprintf(fd, "ideal temp_ideal = %s;\n", iiStringMatrix((matrix) r->qideal, 1, currRing, n_GetChar(r->cf))) == EOF) return TRUE; if (fputs("attrib(temp_ideal, \"isSB\", 1);\n",fd) == EOF) return TRUE; if (fprintf(fd, "qring %s = temp_ideal;\n",IDID(h)) == EOF) return TRUE; if (fputs("kill temp_ring;\n",fd) == EOF) return TRUE; else { omFree(ring_str); return FALSE; } } static BOOLEAN CollectLibs(char *name, char *** list_of_libs) { if (*list_of_libs==NULL) { #define MAX_LIBS 256 (*list_of_libs)=(char**)omAlloc0(MAX_LIBS*sizeof(char**)); (*list_of_libs)[0]=name; (*list_of_libs)[MAX_LIBS-1]=(char*)1; return FALSE; } else { char **p=*list_of_libs; while (((*p)!=NULL)&&((*p!=(char*)1))) { if (strcmp((*p),name)==0) return FALSE; p++; } if (*p==(char*)1) { WerrorS("too many libs"); return TRUE; } else { *p=name; } } return FALSE; } static int DumpRhs(FILE *fd, idhdl h) { int type_id = IDTYP(h); if (type_id == LIST_CMD) { lists l = IDLIST(h); int i, nl = l->nr; fputs("list(",fd); for (i=0; im[i])) == EOF) return EOF; fputs(",",fd); } if (nl > 0) { if (DumpRhs(fd, (idhdl) &(l->m[nl])) == EOF) return EOF; } fputs(")",fd); } else if (type_id == STRING_CMD) { char *pstr = IDSTRING(h); fputc('"', fd); while (*pstr != '\0') { if (*pstr == '"' || *pstr == '\\') fputc('\\', fd); fputc(*pstr, fd); pstr++; } fputc('"', fd); } else if (type_id == PROC_CMD) { procinfov pi = IDPROC(h); if (pi->language == LANG_SINGULAR) { /* pi-Libname==NULL */ char *pstr = pi->data.s.body; fputc('"', fd); while (*pstr != '\0') { if (*pstr == '"' || *pstr == '\\') fputc('\\', fd); fputc(*pstr, fd); pstr++; } fputc('"', fd); } else fputs("(null)", fd); } else { char *rhs = h->String(); if (rhs == NULL) return EOF; BOOLEAN need_klammer=FALSE; if (type_id == INTVEC_CMD) { fputs("intvec(",fd);need_klammer=TRUE; } else if (type_id == IDEAL_CMD) { fputs("ideal(",fd);need_klammer=TRUE; } else if ((type_id == MODUL_CMD)||(type_id == SMATRIX_CMD)) { fputs("module(",fd);need_klammer=TRUE; } else if (type_id == BIGINT_CMD) { fputs("bigint(",fd);need_klammer=TRUE; } if (fputs(rhs,fd) == EOF) return EOF; omFree(rhs); if ((type_id == RING_CMD) && IDRING(h)->cf->type==n_algExt) { StringSetS(""); p_Write(IDRING(h)->cf->extRing->qideal->m[0],IDRING(h)->cf->extRing); rhs = StringEndS(); if (fprintf(fd, "; minpoly = %s", rhs) == EOF) { omFree(rhs); return EOF;} omFree(rhs); } else if (need_klammer) fputc(')',fd); } return 1; } BOOLEAN slGetDumpAscii(si_link l) { if (l->name[0] == '\0') { WerrorS("getdump: Can not get dump from stdin"); return TRUE; } else { BOOLEAN status = newFile(l->name); if (status) return TRUE; int old_echo=si_echo; si_echo=0; status=yyparse(); si_echo=old_echo; if (status) return TRUE; else { // lets reset the file pointer to the end to reflect that // we are finished with reading FILE *f = (FILE *) l->data; fseek(f, 0L, SEEK_END); return FALSE; } } } void slStandardInit() { si_link_extension s; si_link_root=(si_link_extension)omAlloc0Bin(s_si_link_extension_bin); si_link_root->Open=slOpenAscii; si_link_root->Close=slCloseAscii; si_link_root->Kill=NULL; si_link_root->Read=slReadAscii; si_link_root->Read2=slReadAscii2; si_link_root->Write=slWriteAscii; si_link_root->Dump=slDumpAscii; si_link_root->GetDump=slGetDumpAscii; si_link_root->Status=slStatusAscii; si_link_root->type="ASCII"; s = si_link_root; s->next = NULL; }