"Fossies" - the Fresh Open Source Software Archive

Member "bas-2.6/value.c" (2 Jul 2019, 33732 Bytes) of package /linux/privat/bas-2.6.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "value.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.5_vs_2.6.

    1 /* #includes */ /*{{{C}}}*//*{{{*/
    2 #undef  _POSIX_SOURCE
    3 #define _POSIX_SOURCE   1
    4 #undef  _POSIX_C_SOURCE
    5 #define _POSIX_C_SOURCE 2
    6 
    7 #include "config.h"
    8 
    9 #include <assert.h>
   10 #include <ctype.h>
   11 #include <errno.h>
   12 #include <float.h>
   13 #ifdef HAVE_GETTEXT
   14 #include <libintl.h>
   15 #define _(String) gettext(String)
   16 #else
   17 #define _(String) String
   18 #endif
   19 #include <limits.h>
   20 #include <math.h>
   21 /* Buggy on some systems */
   22 #if 0
   23 #ifdef HAVE_TGMATH_H
   24 #include <tgmath.h>
   25 #endif
   26 #else
   27 extern long int lrint(double x);
   28 #endif
   29 #include <stdarg.h>
   30 #include <stdio.h>
   31 #include <stdlib.h>
   32 #include <string.h>
   33 
   34 #include "error.h"
   35 #include "value.h"
   36 
   37 #ifdef USE_DMALLOC
   38 #include "dmalloc.h"
   39 #endif
   40 /*}}}*/
   41 
   42 /* variables */ /*{{{*/
   43 static const char *typestr[]=
   44 {
   45   (const char*)0,
   46   (const char*)0,
   47   "integer",
   48   (const char*)0,
   49   "real",
   50   "string",
   51   "void"
   52 };
   53 
   54 /* for xgettext */
   55 #if 0
   56 _("integer")
   57 _("real")
   58 _("string")
   59 _("void")
   60 #endif
   61 /*}}}*/
   62 
   63 const enum ValueType Value_commonType[V_VOID+1][V_VOID+1]=
   64 {
   65   { 0, 0,       0,         0,       0,       0,        0       },
   66   { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_ERROR,  V_ERROR },
   67   { 0, V_ERROR, V_INTEGER, V_ERROR, V_REAL,  V_ERROR,  V_ERROR },
   68   { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_ERROR,  V_ERROR },
   69   { 0, V_ERROR, V_REAL,    V_ERROR, V_REAL,  V_ERROR,  V_ERROR },
   70   { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_STRING, V_ERROR },
   71   { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_ERROR,  V_ERROR }
   72 };
   73 
   74 #ifndef HAVE_LRINT
   75 long int lrint(double d)
   76 {
   77   return d;
   78 }
   79 #endif
   80 
   81 static void format_double(struct String *buf, double value, int width, int precision, int exponent) /*{{{*/
   82 {
   83   if (exponent)
   84   {
   85     size_t len;
   86     char *e;
   87     int en;
   88 
   89     len=buf->length;
   90     String_appendPrintf(buf,"%.*E",width-1-(precision>=0),value);
   91     if (buf->character[len+1]=='.') String_delete(buf,len+1,1);
   92     if (precision>=0) String_insertChar(buf,len+width-precision-1,'.');
   93     for (e=buf->character+buf->length-1; e>=buf->character && *e!='E'; --e);
   94     ++e;
   95     en=strtol(e,(char**)0,10);
   96     en=en+2-(width-precision);
   97     len=e-buf->character;
   98     String_delete(buf,len,buf->length-len);
   99     String_appendPrintf(buf,"%+0*d",exponent-1,en);
  100   }
  101   else if (precision>0) String_appendPrintf(buf,"%.*f",precision,value);
  102   else if (precision==0) String_appendPrintf(buf,"%.f.",value);
  103   else if (width) String_appendPrintf(buf,"%.f",value);
  104   else
  105   {
  106     double x=value;
  107 
  108     if (x<0.0001 || x>=10000000.0) /* print scientific notation */
  109     {
  110       String_appendPrintf(buf,"%.7g",value);
  111     }
  112     else /* print decimal numbers or integers, if possible */
  113     {
  114       int o,n,p=6;
  115 
  116       while (x>=10.0 && p>0) { x/=10.0; --p; }
  117       o=buf->length;
  118       String_appendPrintf(buf,"%.*f",p,value);
  119       n=buf->length;
  120       if (memchr(buf->character+o,'.',n-o))
  121       {
  122         while (buf->character[buf->length-1]=='0') --buf->length;
  123         if (buf->character[buf->length-1]=='.') --buf->length;
  124       }
  125     }
  126   }
  127 }
  128 /*}}}*/
  129 
  130 double Value_trunc(double d) /*{{{*/
  131 {
  132   return (d<0.0?ceil(d):floor(d));
  133 }
  134 /*}}}*/
  135 double Value_round(double d) /*{{{*/
  136 {
  137   return (d<0.0?ceil(d-0.5):floor(d+0.5));
  138 }
  139 /*}}}*/
  140 long int Value_toi(double d, int *overflow) /*{{{*/
  141 {
  142   d=Value_round(d);
  143   *overflow=(d<LONG_MIN || d>LONG_MAX);
  144   return lrint(d);
  145 }
  146 /*}}}*/
  147 long int Value_vali(const char *s, char **end, int *overflow) /*{{{*/
  148 {
  149   long int n;
  150 
  151   errno=0;
  152   if (*s=='&' && tolower(*(s+1))=='h') n=strtoul(s+2,end,16);
  153   else if (*s=='&' && tolower(*(s+1))=='o') n=strtoul(s+2,end,8);
  154   else n=strtol(s,end,10);
  155   *overflow=(errno==ERANGE);
  156   return n;
  157 }
  158 /*}}}*/
  159 double Value_vald(const char *s, char **end, int *overflow) /*{{{*/
  160 {
  161   double d;
  162 
  163   errno=0;
  164   d=strtod(s,end);
  165   *overflow=(errno==ERANGE);
  166   return d;
  167 }
  168 /*}}}*/
  169 
  170 struct Value *Value_new_NIL(struct Value *this) /*{{{*/
  171 {
  172   assert(this!=(struct Value*)0);
  173   this->type=V_NIL;
  174   return this;
  175 }
  176 /*}}}*/
  177 struct Value *Value_new_ERROR(struct Value *this, int code, const char *error, ...) /*{{{*/
  178 {
  179   va_list ap;
  180   char buf[128];
  181 
  182   assert(this!=(struct Value*)0);
  183   va_start(ap,error);
  184   vsprintf(buf,error,ap);
  185   va_end(ap);
  186   this->type=V_ERROR;
  187   this->u.error.code=code;
  188   this->u.error.msg=strcpy(malloc(strlen(buf)+1),buf);
  189   return this;
  190 }
  191 /*}}}*/
  192 struct Value *Value_new_INTEGER(struct Value *this, long n) /*{{{*/
  193 {
  194   assert(this!=(struct Value*)0);
  195   this->type=V_INTEGER;
  196   this->u.integer=n;
  197   return this;
  198 }
  199 /*}}}*/
  200 struct Value *Value_new_REAL(struct Value *this, double n) /*{{{*/
  201 {
  202   assert(this!=(struct Value*)0);
  203   this->type=V_REAL;
  204   this->u.real=n;
  205   return this;
  206 }
  207 /*}}}*/
  208 struct Value *Value_new_STRING(struct Value *this) /*{{{*/
  209 {
  210   assert(this!=(struct Value*)0);
  211   this->type=V_STRING;
  212   String_new(&this->u.string);
  213   return this;
  214 }
  215 /*}}}*/
  216 struct Value *Value_new_VOID(struct Value *this) /*{{{*/
  217 {
  218   assert(this!=(struct Value*)0);
  219   this->type=V_VOID;
  220   return this;
  221 }
  222 /*}}}*/
  223 struct Value *Value_new_null(struct Value *this, enum ValueType type) /*{{{*/
  224 {
  225   assert(this!=(struct Value*)0);
  226   switch (type)
  227   {
  228     case V_INTEGER:
  229     {
  230       this->type=V_INTEGER;
  231       this->u.integer=0;
  232       break;
  233     }
  234     case V_REAL:
  235     {
  236       this->type=V_REAL;
  237       this->u.real=0.0;
  238       break;
  239     }
  240     case V_STRING:
  241     {
  242       this->type=V_STRING;
  243       String_new(&this->u.string);
  244       break;
  245     }
  246     case V_VOID:
  247     {
  248       this->type=V_VOID;
  249       break;
  250     }
  251     default: assert(0);
  252   }
  253   return this;
  254 }
  255 /*}}}*/
  256 int Value_isNull(const struct Value *this) /*{{{*/
  257 {
  258   switch (this->type)
  259   {
  260     case V_INTEGER: return (this->u.integer==0);
  261     case V_REAL: return (this->u.real==0.0);
  262     case V_STRING: return (this->u.string.length==0);
  263     default: assert(0);
  264   }
  265   return -1;
  266 }
  267 /*}}}*/
  268 void Value_destroy(struct Value *this) /*{{{*/
  269 {
  270   assert(this!=(struct Value*)0);
  271   switch (this->type)
  272   {
  273     case V_ERROR: free(this->u.error.msg); break;
  274     case V_INTEGER: break;
  275     case V_NIL: break;
  276     case V_REAL: break;
  277     case V_STRING: String_destroy(&this->u.string); break;
  278     case V_VOID: break;
  279     default: assert(0);
  280   }
  281   this->type=0;
  282 }
  283 /*}}}*/
  284 struct Value *Value_clone(struct Value *this, const struct Value *original) /*{{{*/
  285 {
  286   assert(this!=(struct Value*)0);
  287   assert(original!=(struct Value*)0);
  288   switch (original->type)
  289   {
  290     case V_ERROR:
  291     {
  292       strcpy(this->u.error.msg=malloc(strlen(original->u.error.msg)+1),original->u.error.msg);
  293       this->u.error.code=original->u.error.code;
  294       break;
  295     }
  296     case V_INTEGER: this->u.integer=original->u.integer; break;
  297     case V_NIL: break;
  298     case V_REAL: this->u.real=original->u.real; break;
  299     case V_STRING: String_clone(&this->u.string,&original->u.string); break;
  300     default: assert(0);
  301   }
  302   this->type=original->type;
  303   return this;
  304 }
  305 /*}}}*/
  306 struct Value *Value_uplus(struct Value *this, int calc) /*{{{*/
  307 {
  308   switch (this->type)
  309   {
  310     case V_INTEGER:
  311     case V_REAL:
  312     {
  313       break;
  314     }
  315     case V_STRING:
  316     {
  317       Value_destroy(this);
  318       Value_new_ERROR(this,INVALIDUOPERAND);
  319       break;
  320     }
  321     default: assert(0);
  322   }
  323   return this;
  324 }
  325 /*}}}*/
  326 struct Value *Value_uneg(struct Value *this, int calc) /*{{{*/
  327 {
  328   switch (this->type)
  329   {
  330     case V_INTEGER:
  331     {
  332       if (calc) this->u.integer=-this->u.integer;
  333       break;
  334     }
  335     case V_REAL:
  336     {
  337       if (calc) this->u.real=-this->u.real;
  338       break;
  339     }
  340     case V_STRING:
  341     {
  342       Value_destroy(this);
  343       Value_new_ERROR(this,INVALIDUOPERAND);
  344       break;
  345     }
  346     default: assert(0);
  347   }
  348   return this;
  349 }
  350 /*}}}*/
  351 struct Value *Value_unot(struct Value *this, int calc) /*{{{*/
  352 {
  353   switch (this->type)
  354   {
  355     case V_INTEGER:
  356     {
  357       if (calc) this->u.integer=~this->u.integer;
  358       break;
  359     }
  360     case V_REAL:
  361     {
  362       Value_retype(this,V_INTEGER);
  363       if (calc) this->u.integer=~this->u.integer;
  364       break;
  365     }
  366     case V_STRING:
  367     {
  368       Value_destroy(this);
  369       Value_new_ERROR(this,INVALIDUOPERAND);
  370       break;
  371     }
  372     default: assert(0);
  373   }
  374   return this;
  375 }
  376 /*}}}*/
  377 struct Value *Value_add(struct Value *this, struct Value *x, int calc) /*{{{*/
  378 {
  379   switch (Value_commonType[this->type][x->type])
  380   {
  381     case V_INTEGER:
  382     {
  383       VALUE_RETYPE(this,V_INTEGER);
  384       VALUE_RETYPE(x,V_INTEGER);
  385       if (calc) this->u.integer+=x->u.integer;
  386       break;
  387     }
  388     case V_REAL:
  389     {
  390       VALUE_RETYPE(this,V_REAL);
  391       VALUE_RETYPE(x,V_REAL);
  392       if (calc) this->u.real+=x->u.real;
  393       break;
  394     }
  395     case V_STRING:
  396     {
  397       if (calc) String_appendString(&this->u.string,&x->u.string);
  398       break;
  399     }
  400     default: assert(0);
  401   }
  402   return this;
  403 }
  404 /*}}}*/
  405 struct Value *Value_sub(struct Value *this, struct Value *x, int calc) /*{{{*/
  406 {
  407   switch (Value_commonType[this->type][x->type])
  408   {
  409     case V_INTEGER:
  410     {
  411       VALUE_RETYPE(this,V_INTEGER);
  412       VALUE_RETYPE(x,V_INTEGER);
  413       if (calc) this->u.integer-=x->u.integer;
  414       break;
  415     }
  416     case V_REAL:
  417     {
  418       VALUE_RETYPE(this,V_REAL);
  419       VALUE_RETYPE(x,V_REAL);
  420       if (calc) this->u.real-=x->u.real;
  421       break;
  422     }
  423     case V_STRING:
  424     {
  425       Value_destroy(this);
  426       Value_new_ERROR(this,INVALIDOPERAND);
  427       break;
  428     }
  429     default: assert(0);
  430   }
  431   return this;
  432 }
  433 /*}}}*/
  434 struct Value *Value_mult(struct Value *this, struct Value *x, int calc) /*{{{*/
  435 {
  436   switch (Value_commonType[this->type][x->type])
  437   {
  438     case V_INTEGER:
  439     {
  440       VALUE_RETYPE(this,V_INTEGER);
  441       VALUE_RETYPE(x,V_INTEGER);
  442       if (calc) this->u.integer*=x->u.integer;
  443       break;
  444     }
  445     case V_REAL:
  446     {
  447       VALUE_RETYPE(this,V_REAL);
  448       VALUE_RETYPE(x,V_REAL);
  449       if (calc) this->u.real*=x->u.real;
  450       break;
  451     }
  452     case V_STRING:
  453     {
  454       Value_destroy(this);
  455       Value_new_ERROR(this,INVALIDOPERAND);
  456       break;
  457     }
  458     default: assert(0);
  459   }
  460   return this;
  461 }
  462 /*}}}*/
  463 struct Value *Value_div(struct Value *this, struct Value *x, int calc) /*{{{*/
  464 {
  465   switch (Value_commonType[this->type][x->type])
  466   {
  467     case V_INTEGER:
  468     {
  469       VALUE_RETYPE(this,V_REAL);
  470       VALUE_RETYPE(x,V_REAL);
  471       if (calc)
  472       {
  473         if (x->u.real==0)
  474         {
  475           Value_destroy(this);
  476           Value_new_ERROR(this,UNDEFINED,"Division by zero");
  477         }
  478         else this->u.real/=x->u.real;
  479       }
  480       break;
  481     }
  482     case V_REAL:
  483     {
  484       VALUE_RETYPE(this,V_REAL);
  485       VALUE_RETYPE(x,V_REAL);
  486       if (calc)
  487       {
  488         if (x->u.real==0.0)
  489         {
  490           Value_destroy(this);
  491           Value_new_ERROR(this,UNDEFINED,"Division by zero");
  492         }
  493         else this->u.real/=x->u.real;
  494       }
  495       break;
  496     }
  497     case V_STRING:
  498     {
  499       Value_destroy(this);
  500       Value_new_ERROR(this,INVALIDOPERAND);
  501       break;
  502     }
  503     default: assert(0);
  504   }
  505   return this;
  506 }
  507 /*}}}*/
  508 struct Value *Value_idiv(struct Value *this, struct Value *x, int calc) /*{{{*/
  509 {
  510   switch (Value_commonType[this->type][x->type])
  511   {
  512     case V_INTEGER:
  513     {
  514       VALUE_RETYPE(this,V_INTEGER);
  515       VALUE_RETYPE(x,V_INTEGER);
  516       if (calc)
  517       {
  518         if (x->u.integer==0)
  519         {
  520           Value_destroy(this);
  521           Value_new_ERROR(this,UNDEFINED,"Division by zero");
  522         }
  523         else this->u.integer/=x->u.integer;
  524       }
  525       break;
  526     }
  527     case V_REAL:
  528     {
  529       VALUE_RETYPE(this,V_REAL);
  530       VALUE_RETYPE(x,V_REAL);
  531       if (calc)
  532       {
  533         if (x->u.real==0.0)
  534         {
  535           Value_destroy(this);
  536           Value_new_ERROR(this,UNDEFINED,"Division by zero");
  537         }
  538         else this->u.real=Value_trunc(this->u.real/x->u.real);
  539       }
  540       break;
  541     }
  542     case V_STRING:
  543     {
  544       Value_destroy(this);
  545       Value_new_ERROR(this,INVALIDOPERAND);
  546       break;
  547     }
  548     default: assert(0);
  549   }
  550   return this;
  551 }
  552 /*}}}*/
  553 struct Value *Value_mod(struct Value *this, struct Value *x, int calc) /*{{{*/
  554 {
  555   switch (Value_commonType[this->type][x->type])
  556   {
  557     case V_INTEGER:
  558     {
  559       VALUE_RETYPE(this,V_INTEGER);
  560       VALUE_RETYPE(x,V_INTEGER);
  561       if (calc)
  562       {
  563         if (x->u.integer==0)
  564         {
  565           Value_destroy(this);
  566           Value_new_ERROR(this,UNDEFINED,"Modulo by zero");
  567         }
  568         else this->u.integer%=x->u.integer;
  569       }
  570       break;
  571     }
  572     case V_REAL:
  573     {
  574       VALUE_RETYPE(this,V_REAL);
  575       VALUE_RETYPE(x,V_REAL);
  576       if (calc)
  577       {
  578         if (x->u.real==0.0)
  579         {
  580           Value_destroy(this);
  581           Value_new_ERROR(this,UNDEFINED,"Modulo by zero");
  582         }
  583         else this->u.real=fmod(this->u.real,x->u.real);
  584       }
  585       break;
  586     }
  587     case V_STRING:
  588     {
  589       Value_destroy(this);
  590       Value_new_ERROR(this,INVALIDOPERAND);
  591       break;
  592     }
  593     default: assert(0);
  594   }
  595   return this;
  596 }
  597 /*}}}*/
  598 struct Value *Value_pow(struct Value *this, struct Value *x, int calc) /*{{{*/
  599 {
  600   switch (Value_commonType[this->type][x->type])
  601   {
  602     case V_INTEGER:
  603     {
  604       VALUE_RETYPE(this,V_INTEGER);
  605       VALUE_RETYPE(x,V_INTEGER);
  606       if (calc)
  607       {
  608         if (this->u.integer==0 && x->u.integer==0)
  609         {
  610           Value_destroy(this);
  611           Value_new_ERROR(this,UNDEFINED,"0^0");
  612         }
  613         else if (x->u.integer>0) this->u.integer=pow(this->u.integer,x->u.integer);
  614         else
  615         {
  616           long int thisi=this->u.integer;
  617           Value_destroy(this);
  618           Value_new_REAL(this,pow(thisi,x->u.integer));
  619         }
  620       }
  621       break;
  622     }
  623     case V_REAL:
  624     {
  625       VALUE_RETYPE(this,V_REAL);
  626       VALUE_RETYPE(x,V_REAL);
  627       if (calc)
  628       {
  629         if (this->u.real==0.0 && x->u.real==0.0)
  630         {
  631           Value_destroy(this);
  632           Value_new_ERROR(this,UNDEFINED,"0^0");
  633         }
  634         else this->u.real=pow(this->u.real,x->u.real);
  635       }
  636       break;
  637     }
  638     case V_STRING:
  639     {
  640       Value_destroy(this);
  641       Value_new_ERROR(this,INVALIDOPERAND);
  642       break;
  643     }
  644     default: assert(0);
  645   }
  646   return this;
  647 }
  648 /*}}}*/
  649 struct Value *Value_and(struct Value *this, struct Value *x, int calc) /*{{{*/
  650 {
  651   switch (Value_commonType[this->type][x->type])
  652   {
  653     case V_INTEGER:
  654     case V_REAL:
  655     {
  656       VALUE_RETYPE(this,V_INTEGER);
  657       VALUE_RETYPE(x,V_INTEGER);
  658       if (calc) this->u.integer&=x->u.integer;
  659       break;
  660     }
  661     case V_STRING:
  662     {
  663       Value_destroy(this);
  664       Value_new_ERROR(this,INVALIDOPERAND);
  665       break;
  666     }
  667     default: assert(0);
  668   }
  669   return this;
  670 }
  671 /*}}}*/
  672 struct Value *Value_or(struct Value *this, struct Value *x, int calc) /*{{{*/
  673 {
  674   switch (Value_commonType[this->type][x->type])
  675   {
  676     case V_INTEGER:
  677     case V_REAL:
  678     {
  679       VALUE_RETYPE(this,V_INTEGER);
  680       VALUE_RETYPE(x,V_INTEGER);
  681       if (calc) this->u.integer|=x->u.integer;
  682       break;
  683     }
  684     case V_STRING:
  685     {
  686       Value_destroy(this);
  687       Value_new_ERROR(this,INVALIDOPERAND);
  688       break;
  689     }
  690     default: assert(0);
  691   }
  692   return this;
  693 }
  694 /*}}}*/
  695 struct Value *Value_xor(struct Value *this, struct Value *x, int calc) /*{{{*/
  696 {
  697   switch (Value_commonType[this->type][x->type])
  698   {
  699     case V_INTEGER:
  700     case V_REAL:
  701     {
  702       VALUE_RETYPE(this,V_INTEGER);
  703       VALUE_RETYPE(x,V_INTEGER);
  704       if (calc) this->u.integer^=x->u.integer;
  705       break;
  706     }
  707     case V_STRING:
  708     {
  709       Value_destroy(this);
  710       Value_new_ERROR(this,INVALIDOPERAND);
  711       break;
  712     }
  713     default: assert(0);
  714   }
  715   return this;
  716 }
  717 /*}}}*/
  718 struct Value *Value_eqv(struct Value *this, struct Value *x, int calc) /*{{{*/
  719 {
  720   switch (Value_commonType[this->type][x->type])
  721   {
  722     case V_INTEGER:
  723     case V_REAL:
  724     {
  725       VALUE_RETYPE(this,V_INTEGER);
  726       VALUE_RETYPE(x,V_INTEGER);
  727       if (calc) this->u.integer=~(this->u.integer^x->u.integer);
  728       break;
  729     }
  730     case V_STRING:
  731     {
  732       Value_destroy(this);
  733       Value_new_ERROR(this,INVALIDOPERAND);
  734       break;
  735     }
  736     default: assert(0);
  737   }
  738   return this;
  739 }
  740 /*}}}*/
  741 struct Value *Value_imp(struct Value *this, struct Value *x, int calc) /*{{{*/
  742 {
  743   switch (Value_commonType[this->type][x->type])
  744   {
  745     case V_INTEGER:
  746     case V_REAL:
  747     {
  748       VALUE_RETYPE(this,V_INTEGER);
  749       VALUE_RETYPE(x,V_INTEGER);
  750       if (calc) this->u.integer=(~this->u.integer)|x->u.integer;
  751       break;
  752     }
  753     case V_STRING:
  754     {
  755       Value_destroy(this);
  756       Value_new_ERROR(this,INVALIDOPERAND);
  757       break;
  758     }
  759     default: assert(0);
  760   }
  761   return this;
  762 }
  763 /*}}}*/
  764 struct Value *Value_lt(struct Value *this, struct Value *x, int calc) /*{{{*/
  765 {
  766   switch (Value_commonType[this->type][x->type])
  767   {
  768     case V_INTEGER:
  769     {
  770       VALUE_RETYPE(this,V_INTEGER);
  771       VALUE_RETYPE(x,V_INTEGER);
  772       if (calc) this->u.integer=(this->u.integer<x->u.integer)?-1:0;
  773       break;
  774     }
  775     case V_REAL:
  776     {
  777       int v;
  778 
  779       VALUE_RETYPE(this,V_REAL);
  780       VALUE_RETYPE(x,V_REAL);
  781       if (calc) v=(this->u.real<x->u.real)?-1:0;
  782       else v=0;
  783       Value_destroy(this);
  784       Value_new_INTEGER(this,v);
  785       break;
  786     }
  787     case V_STRING:
  788     {
  789       int v;
  790 
  791       if (calc) v=(String_cmp(&this->u.string,&x->u.string)<0)?-1:0;
  792       else v=0;
  793       Value_destroy(this);
  794       Value_new_INTEGER(this,v);
  795       break;
  796     }
  797     default: assert(0);
  798   }
  799   return this;
  800 }
  801 /*}}}*/
  802 struct Value *Value_le(struct Value *this, struct Value *x, int calc) /*{{{*/
  803 {
  804   switch (Value_commonType[this->type][x->type])
  805   {
  806     case V_INTEGER:
  807     {
  808       VALUE_RETYPE(this,V_INTEGER);
  809       VALUE_RETYPE(x,V_INTEGER);
  810       if (calc) this->u.integer=(this->u.integer<=x->u.integer)?-1:0;
  811       break;
  812     }
  813     case V_REAL:
  814     {
  815       int v;
  816 
  817       VALUE_RETYPE(this,V_REAL);
  818       VALUE_RETYPE(x,V_REAL);
  819       if (calc) v=(this->u.real<=x->u.real)?-1:0;
  820       else v=0;
  821       Value_destroy(this);
  822       Value_new_INTEGER(this,v);
  823       break;
  824     }
  825     case V_STRING:
  826     {
  827       int v;
  828 
  829       if (calc) v=(String_cmp(&this->u.string,&x->u.string)<=0)?-1:0;
  830       else v=0;
  831       Value_destroy(this);
  832       Value_new_INTEGER(this,v);
  833       break;
  834     }
  835     default: assert(0);
  836   }
  837   return this;
  838 }
  839 /*}}}*/
  840 struct Value *Value_eq(struct Value *this, struct Value *x, int calc) /*{{{*/
  841 {
  842   switch (Value_commonType[this->type][x->type])
  843   {
  844     case V_INTEGER:
  845     {
  846       VALUE_RETYPE(this,V_INTEGER);
  847       VALUE_RETYPE(x,V_INTEGER);
  848       if (calc) this->u.integer=(this->u.integer==x->u.integer)?-1:0;
  849       break;
  850     }
  851     case V_REAL:
  852     {
  853       int v;
  854 
  855       VALUE_RETYPE(this,V_REAL);
  856       VALUE_RETYPE(x,V_REAL);
  857       if (calc) v=(this->u.real==x->u.real)?-1:0;
  858       else v=0;
  859       Value_destroy(this);
  860       Value_new_INTEGER(this,v);
  861       break;
  862     }
  863     case V_STRING:
  864     {
  865       int v;
  866 
  867       if (calc) v=(String_cmp(&this->u.string,&x->u.string)==0)?-1:0;
  868       else v=0;
  869       Value_destroy(this);
  870       Value_new_INTEGER(this,v);
  871       break;
  872     }
  873     default: assert(0);
  874   }
  875   return this;
  876 }
  877 /*}}}*/
  878 struct Value *Value_ge(struct Value *this, struct Value *x, int calc) /*{{{*/
  879 {
  880   switch (Value_commonType[this->type][x->type])
  881   {
  882     case V_INTEGER:
  883     {
  884       VALUE_RETYPE(this,V_INTEGER);
  885       VALUE_RETYPE(x,V_INTEGER);
  886       if (calc) this->u.integer=(this->u.integer>=x->u.integer)?-1:0;
  887       break;
  888     }
  889     case V_REAL:
  890     {
  891       int v;
  892 
  893       VALUE_RETYPE(this,V_REAL);
  894       VALUE_RETYPE(x,V_REAL);
  895       if (calc) v=(this->u.real>=x->u.real)?-1:0;
  896       else v=0;
  897       Value_destroy(this);
  898       Value_new_INTEGER(this,v);
  899       break;
  900     }
  901     case V_STRING:
  902     {
  903       int v;
  904 
  905       if (calc) v=(String_cmp(&this->u.string,&x->u.string)>=0)?-1:0;
  906       else v=0;
  907       Value_destroy(this);
  908       Value_new_INTEGER(this,v);
  909       break;
  910     }
  911     default: assert(0);
  912   }
  913   return this;
  914 }
  915 /*}}}*/
  916 struct Value *Value_gt(struct Value *this, struct Value *x, int calc) /*{{{*/
  917 {
  918   switch (Value_commonType[this->type][x->type])
  919   {
  920     case V_INTEGER:
  921     {
  922       VALUE_RETYPE(this,V_INTEGER);
  923       VALUE_RETYPE(x,V_INTEGER);
  924       if (calc) this->u.integer=(this->u.integer>x->u.integer)?-1:0;
  925       break;
  926     }
  927     case V_REAL:
  928     {
  929       int v;
  930 
  931       VALUE_RETYPE(this,V_REAL);
  932       VALUE_RETYPE(x,V_REAL);
  933       if (calc) v=(this->u.real>x->u.real)?-1:0;
  934       else v=0;
  935       Value_destroy(this);
  936       Value_new_INTEGER(this,v);
  937       break;
  938     }
  939     case V_STRING:
  940     {
  941       int v;
  942 
  943       if (calc) v=(String_cmp(&this->u.string,&x->u.string)>0)?-1:0;
  944       else v=0;
  945       Value_destroy(this);
  946       Value_new_INTEGER(this,v);
  947       break;
  948     }
  949     default: assert(0);
  950   }
  951   return this;
  952 }
  953 /*}}}*/
  954 struct Value *Value_ne(struct Value *this, struct Value *x, int calc) /*{{{*/
  955 {
  956   switch (Value_commonType[this->type][x->type])
  957   {
  958     case V_INTEGER:
  959     {
  960       VALUE_RETYPE(this,V_INTEGER);
  961       VALUE_RETYPE(x,V_INTEGER);
  962       if (calc) this->u.integer=(this->u.integer!=x->u.integer)?-1:0;
  963       break;
  964     }
  965     case V_REAL:
  966     {
  967       int v;
  968 
  969       VALUE_RETYPE(this,V_REAL);
  970       VALUE_RETYPE(x,V_REAL);
  971       if (calc) v=(this->u.real!=x->u.real)?-1:0;
  972       else v=0;
  973       Value_destroy(this);
  974       Value_new_INTEGER(this,v);
  975       break;
  976     }
  977     case V_STRING:
  978     {
  979       int v;
  980 
  981       if (calc) v=String_cmp(&this->u.string,&x->u.string)?-1:0;
  982       else v=0;
  983       Value_destroy(this);
  984       Value_new_INTEGER(this,v);
  985       break;
  986     }
  987     default: assert(0);
  988   }
  989   return this;
  990 }
  991 /*}}}*/
  992 int Value_exitFor(struct Value *this, struct Value *limit, struct Value *step) /*{{{*/
  993 {
  994   switch (this->type)
  995   {
  996     case V_INTEGER: return
  997     (
  998       step->u.integer<0
  999       ? (this->u.integer<limit->u.integer)
 1000       : (this->u.integer>limit->u.integer)
 1001     );
 1002     case V_REAL:    return
 1003     (
 1004       step->u.real<0.0
 1005       ? (this->u.real<limit->u.real)
 1006       : (this->u.real>limit->u.real)
 1007     );
 1008     case V_STRING:  return (String_cmp(&this->u.string,&limit->u.string)>0);
 1009     default:        assert(0);
 1010   }
 1011   return -1;
 1012 }
 1013 /*}}}*/
 1014 void Value_errorPrefix(struct Value *this, const char *prefix) /*{{{*/
 1015 {
 1016   size_t prefixlen,msglen;
 1017 
 1018   assert(this->type==V_ERROR);
 1019   prefixlen=strlen(prefix);
 1020   msglen=strlen(this->u.error.msg);
 1021   this->u.error.msg=realloc(this->u.error.msg,prefixlen+msglen+1);
 1022   memmove(this->u.error.msg+prefixlen,this->u.error.msg,msglen);
 1023   memcpy(this->u.error.msg,prefix,prefixlen);
 1024 }
 1025 /*}}}*/
 1026 void Value_errorSuffix(struct Value *this, const char *suffix) /*{{{*/
 1027 {
 1028   size_t suffixlen,msglen;
 1029 
 1030   assert(this->type==V_ERROR);
 1031   suffixlen=strlen(suffix);
 1032   msglen=strlen(this->u.error.msg);
 1033   this->u.error.msg=realloc(this->u.error.msg,suffixlen+msglen+1);
 1034   memcpy(this->u.error.msg+msglen,suffix,suffixlen+1);
 1035 }
 1036 /*}}}*/
 1037 struct Value *Value_new_typeError(struct Value *this, enum ValueType t1, enum ValueType t2) /*{{{*/
 1038 {
 1039   assert(typestr[t1]);
 1040   assert(typestr[t2]);
 1041   return Value_new_ERROR(this,TYPEMISMATCH1,_(typestr[t1]),_(typestr[t2]));
 1042 }
 1043 /*}}}*/
 1044 static void retypeError(struct Value *this, enum ValueType to) /*{{{*/
 1045 {
 1046   enum ValueType thisType=this->type;
 1047 
 1048   assert(typestr[thisType]);
 1049   assert(typestr[to]);
 1050   Value_destroy(this);
 1051   Value_new_ERROR(this,TYPEMISMATCH1,_(typestr[thisType]),_(typestr[to]));
 1052 }
 1053 /*}}}*/
 1054 struct Value *Value_retype(struct Value *this, enum ValueType type) /*{{{*/
 1055 {
 1056   switch (this->type)
 1057   {
 1058     case V_INTEGER:
 1059     {
 1060       switch (type)
 1061       {
 1062         case V_INTEGER: break;
 1063         case V_REAL: this->u.real=this->u.integer; this->type=type; break;
 1064         case V_VOID: Value_destroy(this); Value_new_VOID(this); break;
 1065         default: retypeError(this,type); break;
 1066       }
 1067       break;
 1068     }
 1069     case V_REAL:
 1070     {
 1071       int overflow;
 1072 
 1073       switch (type)
 1074       {
 1075         case V_INTEGER:
 1076         {
 1077           this->u.integer=Value_toi(this->u.real,&overflow);
 1078           this->type=V_INTEGER;
 1079           if (overflow)
 1080           {
 1081             Value_destroy(this);
 1082             Value_new_ERROR(this,OUTOFRANGE,typestr[V_INTEGER]);
 1083           }
 1084           break;
 1085         }
 1086         case V_REAL: break;
 1087         case V_VOID: Value_destroy(this); Value_new_VOID(this); break;
 1088         default: retypeError(this,type); break;
 1089       }
 1090       break;
 1091     }
 1092     case V_STRING:
 1093     {
 1094       switch (type)
 1095       {
 1096         case V_STRING: break;
 1097         case V_VOID: Value_destroy(this); Value_new_VOID(this); break;
 1098         default: retypeError(this,type); break;
 1099       }
 1100       break;
 1101     }
 1102     case V_VOID:
 1103     {
 1104       switch (type)
 1105       {
 1106         case V_VOID: break;
 1107         default: retypeError(this,type);
 1108       }
 1109       break;
 1110     }
 1111     case V_ERROR: break;
 1112     default: assert(0);
 1113   }
 1114   return this;
 1115 }
 1116 /*}}}*/
 1117 struct String *Value_toString(struct Value *this, struct String *s, char pad, int headingsign, size_t width, int commas, int dollar, int dollarleft, int precision, int exponent, int trailingsign) /*{{{*/
 1118 {
 1119   size_t oldlength=s->length;
 1120 
 1121   switch (this->type)
 1122   {
 1123     case V_ERROR: String_appendChars(s,this->u.error.msg); break;
 1124     case V_REAL:
 1125     case V_INTEGER:
 1126     {
 1127       int sign;
 1128       struct String buf;
 1129       size_t totalwidth=width;
 1130 
 1131       String_new(&buf);
 1132       if (this->type==V_INTEGER)
 1133       {
 1134         if (this->u.integer<0)
 1135         {
 1136           sign=-1;
 1137           this->u.integer=-this->u.integer;
 1138         }
 1139         else if (this->u.integer==0) sign=0;
 1140         else sign=1;
 1141       }
 1142       else
 1143       {
 1144         if (this->u.real<0.0)
 1145         {
 1146           sign=-1;
 1147           this->u.real=-this->u.real;
 1148         }
 1149         else if (this->u.real==0.0) sign=0;
 1150         else sign=1;
 1151       }
 1152       switch (headingsign)
 1153       {
 1154         case -1:
 1155         {
 1156           ++totalwidth;
 1157           String_appendChar(&buf,sign==-1?'-':' ');
 1158           break;
 1159         }
 1160         case 0:
 1161         {
 1162           if (sign==-1) String_appendChar(&buf,'-');
 1163           break;
 1164         }
 1165         case 1:
 1166         {
 1167           ++totalwidth;
 1168           String_appendChar(&buf,sign==-1?'-':'+');
 1169           break;
 1170         }
 1171         case 2: break;
 1172         default: assert(0);
 1173       }
 1174       totalwidth+=exponent;
 1175       if (this->type==V_INTEGER)
 1176       {
 1177         if (precision>0 || exponent) format_double(&buf,(double)this->u.integer,width,precision,exponent);
 1178         else if (precision==0) String_appendPrintf(&buf,"%lu.",this->u.integer);
 1179         else String_appendPrintf(&buf,"%lu",this->u.integer);
 1180       }
 1181       else format_double(&buf,this->u.real,width,precision,exponent);
 1182       if (commas)
 1183       {
 1184         size_t digits;
 1185         int first;
 1186 
 1187         first=(headingsign?1:0);
 1188         for (digits=first; digits<buf.length && buf.character[digits]>='0' && buf.character[digits]<='9'; ++digits);
 1189         while (digits>first+3)
 1190         {
 1191           digits-=3;
 1192           String_insertChar(&buf,digits,',');
 1193         }
 1194       }
 1195       if (dollar)
 1196       {
 1197         String_insertChar(&buf,0,'$');
 1198       }
 1199       if (trailingsign==-1)
 1200       {
 1201         ++totalwidth;
 1202         String_appendChar(&buf,sign==-1?'-':' ');
 1203       }
 1204       else if (trailingsign==1)
 1205       {
 1206         ++totalwidth;
 1207         String_appendChar(&buf,sign==-1?'-':'+');
 1208       }
 1209       String_size(s,oldlength+(totalwidth>buf.length?totalwidth:buf.length));
 1210       if (totalwidth>buf.length) memset(s->character+oldlength,pad,totalwidth-buf.length+dollarleft);
 1211       memcpy(s->character+oldlength+(totalwidth>buf.length?(totalwidth-buf.length):0)+dollarleft,buf.character+dollarleft,buf.length-dollarleft);
 1212       if (dollarleft) s->character[oldlength]='$';
 1213       String_destroy(&buf);
 1214       break;
 1215     }
 1216     case V_STRING:
 1217     {
 1218       if (width>0)
 1219       {
 1220         size_t blanks=(this->u.string.length<width?(width-this->u.string.length):0);
 1221 
 1222         String_size(s,oldlength+width);
 1223         memcpy(s->character+oldlength,this->u.string.character,blanks?this->u.string.length:width);
 1224         if (blanks) memset(s->character+oldlength+this->u.string.length,' ',blanks);
 1225       }
 1226       else String_appendString(s,&this->u.string);
 1227       break;
 1228     }
 1229     default: assert(0); return 0;
 1230   }
 1231   return s;
 1232 }
 1233 /*}}}*/
 1234 struct Value *Value_toStringUsing(struct Value *this, struct String *s, struct String *using, size_t *usingpos) /*{{{*/
 1235 {
 1236   char pad=' ';
 1237   int headingsign;
 1238   int width=0;
 1239   int commas=0;
 1240   int dollar=0;
 1241   int dollarleft=0;
 1242   int precision=-1;
 1243   int exponent=0;
 1244   int trailingsign=0;
 1245 
 1246   headingsign=(using->length ? 0 : -1);
 1247   if (*usingpos==using->length) *usingpos=0;
 1248   while (*usingpos<using->length)
 1249   {
 1250     switch (using->character[*usingpos])
 1251     {
 1252       case '_': /* output next char */ /*{{{*/
 1253       {
 1254         ++(*usingpos);
 1255         if (*usingpos<using->length) String_appendChar(s,using->character[(*usingpos)++]);
 1256         else
 1257         {
 1258           Value_destroy(this);
 1259           return Value_new_ERROR(this,MISSINGCHARACTER);
 1260         }
 1261         break;
 1262       }
 1263       /*}}}*/
 1264       case '!': /* output first character of string */ /*{{{*/
 1265       {
 1266         width=1;
 1267         ++(*usingpos);
 1268         goto work;
 1269       }
 1270       /*}}}*/
 1271       case '\\': /* output n characters of string */ /*{{{*/
 1272       {
 1273         width=1;
 1274         ++(*usingpos);
 1275         while (*usingpos<using->length && using->character[*usingpos]==' ')
 1276         {
 1277           ++(*usingpos);
 1278           ++width;
 1279         }
 1280         if (*usingpos<using->length && using->character[*usingpos]=='\\')
 1281         {
 1282           ++(*usingpos);
 1283           ++width;
 1284           goto work;
 1285         }
 1286         else
 1287         {   
 1288           Value_destroy(this);
 1289           return Value_new_ERROR(this,IOERROR,_("unpaired \\ in format"));
 1290         }
 1291         break;
 1292       }
 1293       /*}}}*/
 1294       case '&': /* output string */ /*{{{*/
 1295       {
 1296         width=0;
 1297         ++(*usingpos);
 1298         goto work;
 1299       }
 1300       /*}}}*/
 1301       case '*':
 1302       case '$':
 1303       case '0':
 1304       case '+':
 1305       case '#':
 1306       case '.':
 1307       {
 1308         if (using->character[*usingpos]=='+')
 1309         {
 1310           headingsign=1;
 1311           ++(*usingpos);
 1312         }
 1313         while (*usingpos<using->length && strchr("$#*0,",using->character[*usingpos]))
 1314         {
 1315           switch (using->character[*usingpos])
 1316           {
 1317             case '$': if (width==0) dollarleft=1; if (++dollar>1) ++width; break;
 1318             case '*': pad='*'; ++width; break;
 1319             case '0': pad='0'; ++width; break;
 1320             case ',': commas=1; ++width; break;
 1321             default: ++width;
 1322           }
 1323           ++(*usingpos);
 1324         }
 1325         if (*usingpos<using->length && using->character[*usingpos]=='.' )
 1326         {
 1327           ++(*usingpos);
 1328           ++width;
 1329           precision=0;
 1330           while (*usingpos<using->length && strchr("*#",using->character[*usingpos]))
 1331           {
 1332             ++(*usingpos);
 1333             ++precision;
 1334             ++width;
 1335           }
 1336           if (width==1 && precision==0)
 1337           {
 1338             Value_destroy(this);
 1339             return Value_new_ERROR(this,BADFORMAT);
 1340           }
 1341         }
 1342         if (*usingpos<using->length && using->character[*usingpos]=='-' )
 1343         {  
 1344           ++(*usingpos);
 1345           if (headingsign==0) headingsign=2;
 1346           trailingsign=-1;
 1347         }  
 1348         else if (*usingpos<using->length && using->character[*usingpos]=='+')
 1349         {  
 1350           ++(*usingpos);
 1351           if (headingsign==0) headingsign=2;
 1352           trailingsign=1;
 1353         }  
 1354         while (*usingpos<using->length && using->character[*usingpos]=='^')
 1355         {
 1356           ++(*usingpos);
 1357           ++exponent;
 1358         }
 1359         goto work;
 1360       }
 1361       default:
 1362       {
 1363         String_appendChar(s,using->character[(*usingpos)++]);
 1364       }
 1365     }
 1366   }
 1367   work:
 1368   Value_toString(this,s,pad,headingsign,width,commas,dollar,dollarleft,precision,exponent,trailingsign);
 1369   if ((this->type==V_INTEGER || this->type==V_REAL) && width==0 && precision==-1) String_appendChar(s,' ');
 1370   while (*usingpos<using->length)
 1371   {
 1372     switch (using->character[*usingpos])
 1373     {
 1374       case '_': /* output next char */ /*{{{*/
 1375       {
 1376         ++(*usingpos);
 1377         if (*usingpos<using->length) String_appendChar(s,using->character[(*usingpos)++]);
 1378         else
 1379         {
 1380           Value_destroy(this);
 1381           return Value_new_ERROR(this,MISSINGCHARACTER);
 1382         }
 1383         break;
 1384       }
 1385       /*}}}*/
 1386       case '!':
 1387       case '\\':
 1388       case '&':
 1389       case '*':
 1390       case '0':
 1391       case '+':
 1392       case '#':
 1393       case '.': return this;
 1394       default:
 1395       {
 1396         String_appendChar(s,using->character[(*usingpos)++]);
 1397       }
 1398     }
 1399   }
 1400   return this;
 1401 }
 1402 /*}}}*/
 1403 struct String *Value_toWrite(struct Value *this, struct String *s) /*{{{*/
 1404 {
 1405   switch (this->type)
 1406   {
 1407     case V_INTEGER: String_appendPrintf(s,"%ld",this->u.integer); break;
 1408     case V_REAL: 
 1409     {
 1410       double x;
 1411       int p=DBL_DIG;
 1412       int n,o;
 1413 
 1414       x=(this->u.real<0.0 ? -this->u.real : this->u.real);
 1415       while (x>1.0 && p>0) { x/=10.0; --p; }
 1416       o=s->length;
 1417       String_appendPrintf(s,"%.*f",p,this->u.real);
 1418       n=s->length;
 1419       if (memchr(s->character+o,'.',n-o))
 1420       {
 1421         while (s->character[s->length-1]=='0') --s->length;
 1422         if (s->character[s->length-1]=='.') --s->length;
 1423       }
 1424       break;
 1425     }
 1426     case V_STRING: /*{{{*/
 1427     {
 1428       size_t l=this->u.string.length;
 1429       char *data=this->u.string.character;
 1430       
 1431       String_appendChar(s,'"');
 1432       while (l--)
 1433       {
 1434         if (*data=='"') String_appendChar(s,'"');
 1435         String_appendChar(s,*data);
 1436         ++data;
 1437       }
 1438       String_appendChar(s,'"');
 1439       break;
 1440     }
 1441     /*}}}*/
 1442     default: assert(0);
 1443   }
 1444   return s;
 1445 }
 1446 /*}}}*/
 1447 struct Value *Value_nullValue(enum ValueType type) /*{{{*/
 1448 {
 1449   static struct Value integer={ V_INTEGER };
 1450   static struct Value real={ V_REAL };
 1451   static struct Value string={ V_STRING };
 1452   static char n[]="";
 1453   static int init=0;
 1454 
 1455   if (!init)
 1456   {
 1457     integer.u.integer=0;
 1458     real.u.real=0.0;
 1459     string.u.string.length=0;
 1460     string.u.string.character=n;
 1461   }
 1462   switch (type)
 1463   {
 1464     case V_INTEGER: return &integer;
 1465     case V_REAL: return &real;
 1466     case V_STRING: return &string;
 1467     default: assert(0);
 1468   }
 1469   return (struct Value*)0;
 1470 }
 1471 /*}}}*/