source: git/Singular/links/asciiLink.cc @ 42c397

fieker-DuValspielwiese
Last change on this file since 42c397 was 42c397, checked in by Hans Schoenemann <hannes@…>, 3 years ago
ascii-links: format for lists
  • Property mode set to 100644
File size: 14.5 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
12#include "Singular/tok.h"
13#include "Singular/subexpr.h"
14#include "Singular/ipshell.h"
15#include "Singular/ipid.h"
16#include "Singular/fevoices.h"
17#include "kernel/oswrapper/feread.h"
18#include "Singular/ipshell.h"
19#include "Singular/links/silink.h"
20
21/* declarations */
22static BOOLEAN DumpAscii(FILE *fd, idhdl h,char ***list_of_libs);
23static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h,char ***list_of_libs);
24static const char* GetIdString(idhdl h);
25static int DumpRhs(FILE *fd, idhdl h);
26static BOOLEAN DumpQring(FILE *fd, idhdl h);
27static BOOLEAN DumpNCring(FILE *fd, idhdl h);
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_VAR 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    #if 1
174    case LIST_CMD:
175      {
176        lists l=(lists)v->Data();
177        for(int i=0;i<l->nr;i++)
178        {
179          char *s=l->m[i].String();
180          fwrite(s,strlen(s),1,outfile);
181          omFree(s);
182          if (i!=l->nr-1) fputc(',',outfile);
183          fputc('\n',outfile);
184        }
185        break;
186      }
187    #endif
188    default:
189      s = v->String();
190      // free v ??
191      if (s!=NULL)
192      {
193        fputs(s,outfile);
194        fputc('\n',outfile);
195        omFree((ADDRESS)s);
196      }
197      else
198      {
199        WerrorS("cannot convert to string");
200        err=TRUE;
201      }
202    }
203    v = v->next;
204  }
205  fflush(outfile);
206  return err;
207}
208
209const char* slStatusAscii(si_link l, const char* request)
210{
211  if (strcmp(request, "read") == 0)
212  {
213    if (SI_LINK_R_OPEN_P(l)) return "ready";
214    else return "not ready";
215  }
216  else if (strcmp(request, "write") == 0)
217  {
218    if (SI_LINK_W_OPEN_P(l)) return "ready";
219    else return "not ready";
220  }
221  else return "unknown status request";
222}
223
224/*------------------ Dumping in Ascii format -----------------------*/
225
226BOOLEAN slDumpAscii(si_link l)
227{
228  FILE *fd = (FILE *) l->data;
229  idhdl h = IDROOT, rh = currRingHdl;
230  char **list_of_libs=NULL;
231  BOOLEAN status = DumpAscii(fd, h, &list_of_libs);
232
233  if (! status ) status = DumpAsciiMaps(fd, h, NULL);
234
235  if (currRingHdl != rh) rSetHdl(rh);
236  fprintf(fd, "option(set, intvec(%d, %d));\n", si_opt_1, si_opt_2);
237  char **p=list_of_libs;
238  if (p!=NULL)
239  {
240    while((*p!=NULL) && (*p!=(char*)1))
241    {
242      fprintf(fd,"load(\"%s\",\"try\");\n",*p);
243      p++;
244    }
245    omFree(list_of_libs);
246  }
247  fputs("RETURN();\n",fd);
248  fflush(fd);
249
250  return status;
251}
252
253// we do that recursively, to dump ids in the the order in which they
254// were actually defined
255static BOOLEAN DumpAscii(FILE *fd, idhdl h, char ***list_of_libs)
256{
257  if (h == NULL) return FALSE;
258
259  if (DumpAscii(fd, IDNEXT(h),list_of_libs)) return TRUE;
260
261  // need to set the ring before writing it, otherwise we get in
262  // trouble with minpoly
263  if (IDTYP(h) == RING_CMD)
264    rSetHdl(h);
265
266  if (DumpAsciiIdhdl(fd, h,list_of_libs)) return TRUE;
267
268  if (IDTYP(h) == RING_CMD)
269    return DumpAscii(fd, IDRING(h)->idroot,list_of_libs);
270  else
271    return FALSE;
272}
273
274static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl)
275{
276  if (h == NULL) return FALSE;
277  if (DumpAsciiMaps(fd, IDNEXT(h), rhdl)) return TRUE;
278
279  if (IDTYP(h) == RING_CMD)
280    return DumpAsciiMaps(fd, IDRING(h)->idroot, h);
281  else if (IDTYP(h) == MAP_CMD)
282  {
283    char *rhs;
284    rSetHdl(rhdl);
285    rhs = h->String();
286
287    if (fprintf(fd, "setring %s;\n", IDID(rhdl)) == EOF) return TRUE;
288    if (fprintf(fd, "%s %s = %s, %s;\n", Tok2Cmdname(MAP_CMD), IDID(h),
289                IDMAP(h)->preimage, rhs) == EOF)
290    {
291      omFree(rhs);
292      return TRUE;
293    }
294    else
295    {
296      omFree(rhs);
297      return FALSE;
298    }
299  }
300  else return FALSE;
301}
302
303static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h, char ***list_of_libs)
304{
305  const char *type_str = GetIdString(h);
306  int type_id = IDTYP(h);
307
308  if (type_id == PACKAGE_CMD)
309  {
310    if (strcmp(IDID(h),"Top")==0) return FALSE; // do not dump "Top"
311    if (IDPACKAGE(h)->language==LANG_SINGULAR) return FALSE;
312    if (IDPACKAGE(h)->language==LANG_MIX) return FALSE;
313  }
314  if (type_id == CRING_CMD)
315  {
316    // do not dump the default CRINGs:
317    if (strcmp(IDID(h),"QQ")==0) return FALSE;
318    if (strcmp(IDID(h),"ZZ")==0) return FALSE;
319    #ifdef SINGULAR_4_2
320    if (strcmp(IDID(h),"AE")==0) return FALSE;
321    if (strcmp(IDID(h),"QAE")==0) return FALSE;
322    #endif
323  }
324
325  // we do not throw an error if a wrong type was attempted to be dumped
326  if (type_str == NULL)
327    return FALSE;
328
329  // handle nc-rings separately
330  if ((type_id == RING_CMD)&&(rIsNCRing(IDRING(h))))
331    return DumpNCring(fd,h);
332
333  // handle qrings separately
334  if ((type_id == RING_CMD)&&(IDRING(h)->qideal!=NULL))
335    return DumpQring(fd, h);
336
337  // C-proc not to be dumped
338  if ((type_id == PROC_CMD) && (IDPROC(h)->language == LANG_C))
339    return FALSE;
340
341  // handle libraries
342  if ((type_id == PROC_CMD)
343  && (IDPROC(h)->language == LANG_SINGULAR)
344  && (IDPROC(h)->libname!=NULL))
345    return CollectLibs(IDPROC(h)->libname,list_of_libs);
346
347  // put type and name
348  if (fprintf(fd, "%s %s", type_str, IDID(h)) == EOF)
349    return TRUE;
350  // for matricies, append the dimension
351  if (type_id == MATRIX_CMD)
352  {
353    ideal id = IDIDEAL(h);
354    if (fprintf(fd, "[%d][%d]", id->nrows, id->ncols)== EOF) return TRUE;
355  }
356  else if (type_id == INTMAT_CMD)
357  {
358    if (fprintf(fd, "[%d][%d]", IDINTVEC(h)->rows(), IDINTVEC(h)->cols())
359        == EOF) return TRUE;
360  }
361  else if (type_id == SMATRIX_CMD)
362  {
363    ideal id = IDIDEAL(h);
364    if (fprintf(fd, "[%d][%d]", (int)id->rank, IDELEMS(id))== EOF) return TRUE;
365  }
366
367  if (type_id == PACKAGE_CMD)
368  {
369    return (fputs(";\n",fd) == EOF);
370  }
371
372  // write the equal sign
373  if (fputs(" = ",fd) == EOF) return TRUE;
374
375  // and the right hand side
376  if (DumpRhs(fd, h) == EOF) return TRUE;
377
378  // semicolon und tschuess
379  if (fputs(";\n",fd) == EOF) return TRUE;
380
381  return FALSE;
382}
383
384static const char* GetIdString(idhdl h)
385{
386  int type = IDTYP(h);
387
388  switch(type)
389  {
390    case LIST_CMD:
391    //{
392    //
393    //
394    //  lists l = IDLIST(h);
395    //  int i, nl = l->nr + 1;
396//
397    //  for (i=0; i<nl; i++)
398    //    if (GetIdString((idhdl) &(l->m[i])) == NULL) return NULL;
399    //  break;
400    //}
401    case CRING_CMD:
402    #ifdef SINGULAR_4_2
403    case CNUMBER_CMD:
404    case CMATRIX_CMD:
405    #endif
406    case BIGINT_CMD:
407    case PACKAGE_CMD:
408    case INT_CMD:
409    case INTVEC_CMD:
410    case INTMAT_CMD:
411    case STRING_CMD:
412    case RING_CMD:
413    case QRING_CMD:
414    case PROC_CMD:
415    case NUMBER_CMD:
416    case POLY_CMD:
417    case IDEAL_CMD:
418    case VECTOR_CMD:
419    case MODUL_CMD:
420    case MATRIX_CMD:
421    case SMATRIX_CMD:
422      return Tok2Cmdname(type);
423
424    case MAP_CMD:
425    case LINK_CMD:
426      return NULL;
427
428    default:
429      Warn("Error dump data of type %s", Tok2Cmdname(IDTYP(h)));
430       return NULL;
431  }
432}
433
434static BOOLEAN DumpNCring(FILE *fd, idhdl h)
435{
436  char *ring_str = h->String();
437  ring r=IDRING(h);
438
439  if (rIsPluralRing(r))
440  {
441    if (fprintf(fd, "ring temp_ring = %s;\n", ring_str)
442      == EOF) return TRUE;
443    if (fprintf(fd, "ideal temp_C = %s;\n",
444              iiStringMatrix((matrix) r->GetNC()->C, 2, r, n_GetChar(r->cf)))
445      == EOF) return TRUE;
446    if (fprintf(fd, "ideal temp_D = %s;\n",
447              iiStringMatrix((matrix) r->GetNC()->D, 2, r, n_GetChar(r->cf)))
448      == EOF) return TRUE;
449    if (fprintf(fd, "def %s = nc_algebra(temp_C,temp_D);\n",IDID(h)) == EOF)
450      return TRUE;
451    if (fputs("kill temp_ring;\n",fd) == EOF) return TRUE;
452  }
453  if (rIsLPRing(r))
454  {
455    //if (fprintf(fd, "ring %s = %s;\n", IDID(h), ring_str) == EOF) return TRUE;
456    //if (fprintf(fd, "attrib(%s,\"isLetterplaceRing\",%d);\n",IDID(h),r->isLPring) ==EOF) return TRUE;
457    Warn("cannot write LP ring %s",IDID(h));
458    return TRUE;
459  }
460  omFree(ring_str);
461  return FALSE;
462}
463
464static BOOLEAN DumpQring(FILE *fd, idhdl h)
465{
466  char *ring_str = h->String();
467  ring r=IDRING(h);
468  if (fprintf(fd, "ring temp_ring = %s;\n", ring_str) == EOF) return TRUE;
469  if (fprintf(fd, "ideal temp_ideal = %s;\n",
470              iiStringMatrix((matrix) r->qideal, 1, currRing, n_GetChar(r->cf)))
471      == EOF) return TRUE;
472  if (fputs("attrib(temp_ideal, \"isSB\", 1);\n",fd) == EOF) return TRUE;
473  if (fprintf(fd, "qring %s = temp_ideal;\n",IDID(h)) == EOF)
474    return TRUE;
475  if (fputs("kill temp_ring;\n",fd) == EOF) return TRUE;
476  else
477  {
478    omFree(ring_str);
479    return FALSE;
480  }
481}
482
483static BOOLEAN CollectLibs(char *name, char *** list_of_libs)
484{
485  if (*list_of_libs==NULL)
486  {
487    #define MAX_LIBS 256
488    (*list_of_libs)=(char**)omAlloc0(MAX_LIBS*sizeof(char**));
489    (*list_of_libs)[0]=name;
490    (*list_of_libs)[MAX_LIBS-1]=(char*)1;
491    return FALSE;
492  }
493  else
494  {
495    char **p=*list_of_libs;
496    while (((*p)!=NULL)&&((*p!=(char*)1)))
497    {
498      if (strcmp((*p),name)==0) return FALSE;
499      p++;
500    }
501    if (*p==(char*)1)
502    {
503      WerrorS("too many libs");
504      return TRUE;
505    }
506    else
507    {
508      *p=name;
509    }
510  }
511  return FALSE;
512}
513
514
515static int DumpRhs(FILE *fd, idhdl h)
516{
517  int type_id = IDTYP(h);
518
519  if (type_id == LIST_CMD)
520  {
521    lists l = IDLIST(h);
522    int i, nl = l->nr;
523
524    fputs("list(",fd);
525
526    for (i=0; i<nl; i++)
527    {
528      if (DumpRhs(fd, (idhdl) &(l->m[i])) == EOF) return EOF;
529      fputs(",",fd);
530    }
531    if (nl > 0)
532    {
533      if (DumpRhs(fd, (idhdl) &(l->m[nl])) == EOF) return EOF;
534    }
535    fputs(")",fd);
536  }
537  else  if (type_id == STRING_CMD)
538  {
539    char *pstr = IDSTRING(h);
540    fputc('"', fd);
541    while (*pstr != '\0')
542    {
543      if (*pstr == '"' || *pstr == '\\')  fputc('\\', fd);
544      fputc(*pstr, fd);
545      pstr++;
546    }
547    fputc('"', fd);
548  }
549  else  if (type_id == PROC_CMD)
550  {
551    procinfov pi = IDPROC(h);
552    if (pi->language == LANG_SINGULAR)
553    {
554      /* pi-Libname==NULL */
555      char *pstr = pi->data.s.body;
556      fputc('"', fd);
557      while (*pstr != '\0')
558      {
559        if (*pstr == '"' || *pstr == '\\') fputc('\\', fd);
560        fputc(*pstr, fd);
561        pstr++;
562      }
563      fputc('"', fd);
564    }
565    else fputs("(null)", fd);
566  }
567  else
568  {
569    char *rhs = h->String();
570
571    if (rhs == NULL) return EOF;
572
573    BOOLEAN need_klammer=FALSE;
574    if (type_id == INTVEC_CMD) { fputs("intvec(",fd);need_klammer=TRUE; }
575    else if (type_id == IDEAL_CMD) { fputs("ideal(",fd);need_klammer=TRUE; }
576    else if ((type_id == MODUL_CMD)||(type_id == SMATRIX_CMD))
577                                   { fputs("module(",fd);need_klammer=TRUE; }
578    else if (type_id == BIGINT_CMD) { fputs("bigint(",fd);need_klammer=TRUE; }
579
580    if (fputs(rhs,fd) == EOF) return EOF;
581    omFree(rhs);
582
583    if ((type_id == RING_CMD) &&
584        IDRING(h)->cf->type==n_algExt)
585    {
586      StringSetS("");
587      p_Write(IDRING(h)->cf->extRing->qideal->m[0],IDRING(h)->cf->extRing);
588      rhs = StringEndS();
589      if (fprintf(fd, "; minpoly = %s", rhs) == EOF) { omFree(rhs); return EOF;}
590      omFree(rhs);
591    }
592    else if (need_klammer) fputc(')',fd);
593  }
594  return 1;
595}
596
597BOOLEAN slGetDumpAscii(si_link l)
598{
599  if (l->name[0] == '\0')
600  {
601    WerrorS("getdump: Can not get dump from stdin");
602    return TRUE;
603  }
604  else
605  {
606    BOOLEAN status = newFile(l->name);
607    if (status)
608      return TRUE;
609
610    int old_echo=si_echo;
611    si_echo=0;
612
613    status=yyparse();
614
615    si_echo=old_echo;
616
617    if (status)
618      return TRUE;
619    else
620    {
621      // lets reset the file pointer to the end to reflect that
622      // we are finished with reading
623      FILE *f = (FILE *) l->data;
624      fseek(f, 0L, SEEK_END);
625      return FALSE;
626    }
627  }
628}
629
630
631void slStandardInit()
632{
633  si_link_extension s;
634  si_link_root=(si_link_extension)omAlloc0Bin(s_si_link_extension_bin);
635  si_link_root->Open=slOpenAscii;
636  si_link_root->Close=slCloseAscii;
637  si_link_root->Kill=NULL;
638  si_link_root->Read=slReadAscii;
639  si_link_root->Read2=slReadAscii2;
640  si_link_root->Write=slWriteAscii;
641  si_link_root->Dump=slDumpAscii;
642  si_link_root->GetDump=slGetDumpAscii;
643  si_link_root->Status=slStatusAscii;
644  si_link_root->type="ASCII";
645  s = si_link_root;
646  s->next = NULL;
647}
Note: See TracBrowser for help on using the repository browser.