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