source: git/Singular/links/asciiLink.cc @ 01776f

spielwiese
Last change on this file since 01776f was 01776f, checked in by Hans Schoenemann <hannes@…>, 5 years ago
fix: dump for cring
  • Property mode set to 100644
File size: 13.2 KB
Line 
1/****************************************
2 * *  Computer Algebra System SINGULAR     *
3 * ****************************************/
4
5/*
6 * ABSTRACT: ascii links (standard)
7 */
8
9#include "kernel/mod2.h"
10#include "misc/options.h"
11#include "omalloc/omalloc.h"
12
13#include "Singular/tok.h"
14#include "Singular/subexpr.h"
15#include "Singular/ipshell.h"
16#include "Singular/ipid.h"
17#include "Singular/fevoices.h"
18#include "kernel/oswrapper/feread.h"
19#include "Singular/ipshell.h"
20#include "Singular/links/silink.h"
21
22/* declarations */
23static BOOLEAN DumpAscii(FILE *fd, idhdl h,char ***list_of_libs);
24static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h,char ***list_of_libs);
25static const char* GetIdString(idhdl h);
26static int DumpRhs(FILE *fd, idhdl h);
27static BOOLEAN DumpQring(FILE *fd, idhdl h, const char *type_str);
28static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl);
29static BOOLEAN CollectLibs(char *name, char ***list_of_libs);
30//static BOOLEAN DumpLibs(FILE *fd, char ***list_of_libs);
31
32extern si_link_extension si_link_root;
33
34/* =============== ASCII ============================================= */
35BOOLEAN slOpenAscii(si_link l, short flag, leftv /*h*/)
36{
37  const char *mode;
38  if (flag & SI_LINK_OPEN)
39  {
40    if (l->mode[0] != '\0' && (strcmp(l->mode, "r") == 0))
41      flag = SI_LINK_READ;
42    else flag = SI_LINK_WRITE;
43  }
44
45  if (flag == SI_LINK_READ) mode = "r";
46  else if (strcmp(l->mode, "w") == 0) mode = "w";
47  else mode = "a";
48
49
50  if (l->name[0] == '\0')
51  {
52    // stdin or stdout
53    if (flag == SI_LINK_READ)
54    {
55      l->data = (void *) stdin;
56      mode = "r";
57    }
58    else
59    {
60      l->data = (void *) stdout;
61      mode = "a";
62    }
63  }
64  else
65  {
66    // normal ascii link to a file
67    FILE *outfile;
68    char *filename=l->name;
69
70    if(filename[0]=='>')
71    {
72      if (filename[1]=='>')
73      {
74        filename+=2;
75        mode = "a";
76      }
77      else
78      {
79        filename++;
80        mode="w";
81      }
82    }
83    outfile=myfopen(filename,mode);
84    if (outfile!=NULL)
85      l->data = (void *) outfile;
86    else
87      return TRUE;
88  }
89
90  omFree(l->mode);
91  l->mode = omStrDup(mode);
92  SI_LINK_SET_OPEN_P(l, flag);
93  return FALSE;
94}
95
96BOOLEAN slCloseAscii(si_link l)
97{
98  SI_LINK_SET_CLOSE_P(l);
99  if (l->name[0] != '\0')
100  {
101    return (fclose((FILE *)l->data)!=0);
102  }
103  return FALSE;
104}
105
106leftv slReadAscii2(si_link l, leftv pr)
107{
108  FILE * fp=(FILE *)l->data;
109  char * buf=NULL;
110  if (fp!=NULL && l->name[0] != '\0')
111  {
112    fseek(fp,0L,SEEK_END);
113    long len=ftell(fp);
114    if (len<0) len=0;
115    fseek(fp,0L,SEEK_SET);
116    buf=(char *)omAlloc((int)len+1);
117    if (BVERBOSE(V_READING))
118      Print("//Reading %ld chars\n",len);
119    if (len>0) myfread( buf, len, 1, fp);
120    buf[len]='\0';
121  }
122  else
123  {
124    if (pr->Typ()==STRING_CMD)
125    {
126      buf=(char *)omAlloc(80);
127      fe_fgets_stdin((char *)pr->Data(),buf,80);
128    }
129    else
130    {
131      WerrorS("read(<link>,<string>) expected");
132      buf=omStrDup("");
133    }
134  }
135  leftv v=(leftv)omAlloc0Bin(sleftv_bin);
136  v->rtyp=STRING_CMD;
137  v->data=buf;
138  return v;
139}
140
141leftv slReadAscii(si_link l)
142{
143  sleftv tmp;
144  memset(&tmp,0,sizeof(sleftv));
145  tmp.rtyp=STRING_CMD;
146  tmp.data=(void*) "? ";
147  return slReadAscii2(l,&tmp);
148}
149
150BOOLEAN slWriteAscii(si_link l, leftv v)
151{
152  FILE *outfile=(FILE *)l->data;
153  BOOLEAN err=FALSE;
154  char *s;
155  while (v!=NULL)
156  {
157    switch(v->Typ())
158    {
159    case IDEAL_CMD:
160    case MODUL_CMD:
161    case MATRIX_CMD:
162      {
163        ideal I=(ideal)v->Data();
164        for(int i=0;i<IDELEMS(I);i++)
165        {
166          char *s=pString(I->m[i]);
167          fwrite(s,strlen(s),1,outfile);
168          omFree(s);
169          if (i<IDELEMS(I)-1) fwrite(",",1,1,outfile);
170        }
171        break;
172      }
173    default:
174      s = v->String();
175      // free v ??
176      if (s!=NULL)
177      {
178        fputs(s,outfile);
179        fputc('\n',outfile);
180        omFree((ADDRESS)s);
181      }
182      else
183      {
184        WerrorS("cannot convert to string");
185        err=TRUE;
186      }
187    }
188    v = v->next;
189  }
190  fflush(outfile);
191  return err;
192}
193
194const char* slStatusAscii(si_link l, const char* request)
195{
196  if (strcmp(request, "read") == 0)
197  {
198    if (SI_LINK_R_OPEN_P(l)) return "ready";
199    else return "not ready";
200  }
201  else if (strcmp(request, "write") == 0)
202  {
203    if (SI_LINK_W_OPEN_P(l)) return "ready";
204    else return "not ready";
205  }
206  else return "unknown status request";
207}
208
209/*------------------ Dumping in Ascii format -----------------------*/
210
211BOOLEAN slDumpAscii(si_link l)
212{
213  FILE *fd = (FILE *) l->data;
214  idhdl h = IDROOT, rh = currRingHdl;
215  char **list_of_libs=NULL;
216  BOOLEAN status = DumpAscii(fd, h, &list_of_libs);
217
218  if (! status ) status = DumpAsciiMaps(fd, h, NULL);
219
220  if (currRingHdl != rh) rSetHdl(rh);
221  fprintf(fd, "option(set, intvec(%d, %d));\n", si_opt_1, si_opt_2);
222  char **p=list_of_libs;
223  if (p!=NULL)
224  {
225    while((*p!=NULL) && (*p!=(char*)1))
226    {
227      fprintf(fd,"load(\"%s\",\"try\");\n",*p);
228      p++;
229    }
230    omFree(list_of_libs);
231  }
232  fputs("RETURN();\n",fd);
233  fflush(fd);
234
235  return status;
236}
237
238// we do that recursively, to dump ids in the the order in which they
239// were actually defined
240static BOOLEAN DumpAscii(FILE *fd, idhdl h, char ***list_of_libs)
241{
242  if (h == NULL) return FALSE;
243
244  if (DumpAscii(fd, IDNEXT(h),list_of_libs)) return TRUE;
245
246  // need to set the ring before writing it, otherwise we get in
247  // trouble with minpoly
248  if (IDTYP(h) == RING_CMD)
249    rSetHdl(h);
250
251  if (DumpAsciiIdhdl(fd, h,list_of_libs)) return TRUE;
252
253  if (IDTYP(h) == RING_CMD)
254    return DumpAscii(fd, IDRING(h)->idroot,list_of_libs);
255  else
256    return FALSE;
257}
258
259static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl)
260{
261  if (h == NULL) return FALSE;
262  if (DumpAsciiMaps(fd, IDNEXT(h), rhdl)) return TRUE;
263
264  if (IDTYP(h) == RING_CMD)
265    return DumpAsciiMaps(fd, IDRING(h)->idroot, h);
266  else if (IDTYP(h) == MAP_CMD)
267  {
268    char *rhs;
269    rSetHdl(rhdl);
270    rhs = h->String();
271
272    if (fprintf(fd, "setring %s;\n", IDID(rhdl)) == EOF) return TRUE;
273    if (fprintf(fd, "%s %s = %s, %s;\n", Tok2Cmdname(MAP_CMD), IDID(h),
274                IDMAP(h)->preimage, rhs) == EOF)
275    {
276      omFree(rhs);
277      return TRUE;
278    }
279    else
280    {
281      omFree(rhs);
282      return FALSE;
283    }
284  }
285  else return FALSE;
286}
287
288static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h, char ***list_of_libs)
289{
290  const char *type_str = GetIdString(h);
291  int type_id = IDTYP(h);
292
293  if (type_id == PACKAGE_CMD)
294  {
295    if (strcmp(IDID(h),"Top")==0) return FALSE; // do not dump "Top"
296    if (IDPACKAGE(h)->language==LANG_SINGULAR) return FALSE;
297  }
298  if (type_id == CRING_CMD)
299  {
300    // do not dump the default CRINGs:
301    if (strcmp(IDID(h),"QQ")==0) return FALSE;
302    if (strcmp(IDID(h),"ZZ")==0) return FALSE;
303    #ifdef SINGULAR_4_2
304    if (strcmp(IDID(h),"AE")==0) return FALSE;
305    if (strcmp(IDID(h),"QAE")==0) return FALSE;
306    #endif
307    if (strcmp(IDID(h),"flintQ")==0) return FALSE;
308  }
309
310  // we do not throw an error if a wrong type was attempted to be dumped
311  if (type_str == NULL)
312    return FALSE;
313
314  // handle qrings separately
315  if ((type_id == RING_CMD)&&(IDRING(h)->qideal!=NULL))
316    return DumpQring(fd, h, type_str);
317
318  // C-proc not to be dumped
319  if ((type_id == PROC_CMD) && (IDPROC(h)->language == LANG_C))
320    return FALSE;
321
322  // handle libraries
323  if ((type_id == PROC_CMD)
324  && (IDPROC(h)->language == LANG_SINGULAR)
325  && (IDPROC(h)->libname!=NULL))
326    return CollectLibs(IDPROC(h)->libname,list_of_libs);
327
328  // put type and name
329  if (fprintf(fd, "%s %s", type_str, IDID(h)) == EOF)
330    return TRUE;
331  // for matricies, append the dimension
332  if (type_id == MATRIX_CMD)
333  {
334    ideal id = IDIDEAL(h);
335    if (fprintf(fd, "[%d][%d]", id->nrows, id->ncols)== EOF) return TRUE;
336  }
337  else if (type_id == INTMAT_CMD)
338  {
339    if (fprintf(fd, "[%d][%d]", IDINTVEC(h)->rows(), IDINTVEC(h)->cols())
340        == EOF) return TRUE;
341  }
342  else if (type_id == SMATRIX_CMD)
343  {
344    ideal id = IDIDEAL(h);
345    if (fprintf(fd, "[%d][%d]", (int)id->rank, IDELEMS(id))== EOF) return TRUE;
346  }
347
348  if (type_id == PACKAGE_CMD)
349  {
350    return (fputs(";\n",fd) == EOF);
351  }
352
353  // write the equal sign
354  if (fputs(" = ",fd) == EOF) return TRUE;
355
356  // and the right hand side
357  if (DumpRhs(fd, h) == EOF) return TRUE;
358
359  // semicolon und tschuess
360  if (fputs(";\n",fd) == EOF) return TRUE;
361
362  return FALSE;
363}
364
365static const char* GetIdString(idhdl h)
366{
367  int type = IDTYP(h);
368
369  switch(type)
370  {
371    case LIST_CMD:
372    {
373      lists l = IDLIST(h);
374      int i, nl = l->nr + 1;
375
376      for (i=0; i<nl; i++)
377        if (GetIdString((idhdl) &(l->m[i])) == NULL) return NULL;
378    }
379    case CRING_CMD:
380    #ifdef SINGULAR_4_2
381    case CNUMBER_CMD:
382    case CMATRIX_CMD:
383    #endif
384    case BIGINT_CMD:
385    case PACKAGE_CMD:
386    case INT_CMD:
387    case INTVEC_CMD:
388    case INTMAT_CMD:
389    case STRING_CMD:
390    case RING_CMD:
391    case QRING_CMD:
392    case PROC_CMD:
393    case NUMBER_CMD:
394    case POLY_CMD:
395    case IDEAL_CMD:
396    case VECTOR_CMD:
397    case MODUL_CMD:
398    case MATRIX_CMD:
399    case SMATRIX_CMD:
400      return Tok2Cmdname(type);
401
402    case MAP_CMD:
403    case LINK_CMD:
404      return NULL;
405
406    default:
407      Warn("Error dump data of type %s", Tok2Cmdname(IDTYP(h)));
408       return NULL;
409  }
410}
411
412static BOOLEAN DumpQring(FILE *fd, idhdl h, const char *type_str)
413{
414  char *ring_str = h->String();
415  if (fprintf(fd, "%s temp_ring = %s;\n", Tok2Cmdname(RING_CMD), ring_str)
416              == EOF) return TRUE;
417  if (fprintf(fd, "%s temp_ideal = %s;\n", Tok2Cmdname(IDEAL_CMD),
418              iiStringMatrix((matrix) IDRING(h)->qideal, 1, currRing, n_GetChar(currRing->cf)))
419      == EOF) return TRUE;
420  if (fputs("attrib(temp_ideal, \"isSB\", 1);\n",fd) == EOF) return TRUE;
421  if (fprintf(fd, "%s %s = temp_ideal;\n", type_str, IDID(h)) == EOF)
422    return TRUE;
423  if (fputs("kill temp_ring;\n",fd) == EOF) return TRUE;
424  else
425  {
426    omFree(ring_str);
427    return FALSE;
428  }
429}
430
431static BOOLEAN CollectLibs(char *name, char *** list_of_libs)
432{
433  if (*list_of_libs==NULL)
434  {
435    #define MAX_LIBS 256
436    (*list_of_libs)=(char**)omAlloc0(MAX_LIBS*sizeof(char**));
437    (*list_of_libs)[0]=name;
438    (*list_of_libs)[MAX_LIBS-1]=(char*)1;
439    return FALSE;
440  }
441  else
442  {
443    char **p=*list_of_libs;
444    while (((*p)!=NULL)&&((*p!=(char*)1)))
445    {
446      if (strcmp((*p),name)==0) return FALSE;
447      p++;
448    }
449    if (*p==(char*)1)
450    {
451      WerrorS("too many libs");
452      return TRUE;
453    }
454    else
455    {
456      *p=name;
457    }
458  }
459  return FALSE;
460}
461
462
463static int DumpRhs(FILE *fd, idhdl h)
464{
465  int type_id = IDTYP(h);
466
467  if (type_id == LIST_CMD)
468  {
469    lists l = IDLIST(h);
470    int i, nl = l->nr;
471
472    fputs("list(",fd);
473
474    for (i=0; i<nl; i++)
475    {
476      if (DumpRhs(fd, (idhdl) &(l->m[i])) == EOF) return EOF;
477      fputs(",",fd);
478    }
479    if (nl > 0)
480    {
481      if (DumpRhs(fd, (idhdl) &(l->m[nl])) == EOF) return EOF;
482    }
483    fputs(")",fd);
484  }
485  else  if (type_id == STRING_CMD)
486  {
487    char *pstr = IDSTRING(h);
488    fputc('"', fd);
489    while (*pstr != '\0')
490    {
491      if (*pstr == '"' || *pstr == '\\')  fputc('\\', fd);
492      fputc(*pstr, fd);
493      pstr++;
494    }
495    fputc('"', fd);
496  }
497  else  if (type_id == PROC_CMD)
498  {
499    procinfov pi = IDPROC(h);
500    if (pi->language == LANG_SINGULAR)
501    {
502      /* pi-Libname==NULL */
503      char *pstr = pi->data.s.body;
504      fputc('"', fd);
505      while (*pstr != '\0')
506      {
507        if (*pstr == '"' || *pstr == '\\') fputc('\\', fd);
508        fputc(*pstr, fd);
509        pstr++;
510      }
511      fputc('"', fd);
512    }
513    else fputs("(null)", fd);
514  }
515  else
516  {
517    char *rhs = h->String();
518
519    if (rhs == NULL) return EOF;
520
521    BOOLEAN need_klammer=FALSE;
522    if (type_id == INTVEC_CMD) { fputs("intvec(",fd);need_klammer=TRUE; }
523    else if (type_id == IDEAL_CMD) { fputs("ideal(",fd);need_klammer=TRUE; }
524    else if ((type_id == MODUL_CMD)||(type_id == SMATRIX_CMD))
525                                   { fputs("module(",fd);need_klammer=TRUE; }
526    else if (type_id == BIGINT_CMD) { fputs("bigint(",fd);need_klammer=TRUE; }
527
528    if (fputs(rhs,fd) == EOF) return EOF;
529    omFree(rhs);
530
531    if ((type_id == RING_CMD) &&
532        IDRING(h)->cf->type==n_algExt)
533    {
534      StringSetS("");
535      p_Write(IDRING(h)->cf->extRing->qideal->m[0],IDRING(h)->cf->extRing);
536      rhs = StringEndS();
537      if (fprintf(fd, "; minpoly = %s", rhs) == EOF) { omFree(rhs); return EOF;}
538      omFree(rhs);
539    }
540    else if (need_klammer) fputc(')',fd);
541  }
542  return 1;
543}
544
545BOOLEAN slGetDumpAscii(si_link l)
546{
547  if (l->name[0] == '\0')
548  {
549    WerrorS("getdump: Can not get dump from stdin");
550    return TRUE;
551  }
552  else
553  {
554    BOOLEAN status = newFile(l->name);
555    if (status)
556      return TRUE;
557
558    int old_echo=si_echo;
559    si_echo=0;
560
561    status=yyparse();
562
563    si_echo=old_echo;
564
565    if (status)
566      return TRUE;
567    else
568    {
569      // lets reset the file pointer to the end to reflect that
570      // we are finished with reading
571      FILE *f = (FILE *) l->data;
572      fseek(f, 0L, SEEK_END);
573      return FALSE;
574    }
575  }
576}
577
578
579void slStandardInit()
580{
581  si_link_extension s;
582  si_link_root=(si_link_extension)omAlloc0Bin(s_si_link_extension_bin);
583  si_link_root->Open=slOpenAscii;
584  si_link_root->Close=slCloseAscii;
585  si_link_root->Kill=NULL;
586  si_link_root->Read=slReadAscii;
587  si_link_root->Read2=slReadAscii2;
588  si_link_root->Write=slWriteAscii;
589  si_link_root->Dump=slDumpAscii;
590  si_link_root->GetDump=slGetDumpAscii;
591  si_link_root->Status=slStatusAscii;
592  si_link_root->type="ASCII";
593  s = si_link_root;
594  s->next = NULL;
595}
Note: See TracBrowser for help on using the repository browser.