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