Logo Search packages:      
Sourcecode: gp2c version File versions  Download package

funcdesc.c

/*
Copyright (C) 2000-2005  The PARI group.

This file is part of the GP2C package.

PARI/GP is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation. It is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY WHATSOEVER.

Check the License for details. You should have received a copy of it, along
with the package; see the file 'COPYING'. If not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */

#include "config.h"
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include "header.h"
extern gpfunc listfunc[];

gpdesc *newdesc(int nb)
{
  gpdesc *gd;
  gd=malloc(sizeof(*gd));
  gd->nb=nb;
  gd->a=nb?calloc(nb,sizeof(*(gd->a))):NULL;
  return gd;
}

static void
strtoargsdefault(char *s, descargatom *aa, int opt)
{
  if (isdigit(*s) || *s=='-' || *s=='+')
  {
    aa->t=opt?AAoptsmall:AAsmall;
    aa->type=Gsmall;
    aa->misc=atol(s);
  }
  else
  {
    int t=strtotype(s);
    aa->t=opt?AAopttype:AAtype;
    aa->type=t;
  }
}
/*modify s*/
descargatom
strtoargs(char *s)
{
  descargatom aa;
  int t;
  char *mstr=s;
  aa.mode=0;
  aa.type=Gnotype;
  aa.misc=0;
  while ((mstr=strrchr(mstr,':')))
  {
    aa.mode|=1<<strtomode(mstr+1);
    *mstr=0;
  }
  switch(*s)
  {
  case 0:
    aa.t=AAnoarg;
    return aa;
  case '&':
    aa.t=AAreftype;
    break;
  case '#':
    aa.t=AAherevalue;
    break;
  case '*':
    aa.t=AAlvalue;
    break;
  case '"':
    aa.t=AAstring;
    aa.str=xstrndup(s+1,strlen(s)-2);
    break;
  case '@':
    aa.t=AAmulti;
    break;
  case '.':
    if (s[1]=='.' && s[2]=='.' && s[3]==0)
    {
      aa.t=AAstdarg;
      return aa;
    }
    die(err_desc,"Unknown atom `%s' in description file",s);
  case 'C':
    switch(s[1])
    {
    case '!':
      aa.t=AActype;
      aa.misc=strtoctype(s+2);
      return aa;
    default:
      die(err_desc,"Unknown atom `%s' in description file",s);
    }
  case '?':
    strtoargsdefault(s+1,&aa,1);
    return aa;
  default:
    strtoargsdefault(s,&aa,0);
    return aa;
  }
  t=strtotype(s+1);
  if (t==-1)
    die(err_desc,"Bad reference in description file");
  aa.type=t;
  return aa;
}
void readentry(FILE *f, char *buf, int len)
{
  if (!fgets(buf,len,f))
    perror("gp2c");
  if (!*buf)
    die(err_desc,"Bad description file <entry>");
  buf[strlen(buf)-1]=0;
}

int readnumber(FILE *f, char *buf, int len)
{
  readentry(f,buf,len);
  return atol(buf);
}

int readtypemode(FILE *f,char *buf, int len, int *mode)
{
  int nb=readnumber(f,buf,len);
  int type;
  *mode=0;
  if (nb)
  {
    int j;
    readentry(f,buf,len);
    type=strtotype(buf);
    for(j=1;j<nb;j++)
    {
      readentry(f,buf,len);
      *mode|=1<<strtomode(buf);
    }
  }
  else
    type=Gempty;
  return type;
}

#define BUFFER_SIZE 1024

void initdesc(char *descfile)
{
  char buf[BUFFER_SIZE];
  FILE *dfile;
  if (!(dfile=fopen(descfile,"r")))
    die(err_desc,"Cannot find description file %s",descfile);
  while(!feof(dfile))
  {
    int i;
    int nb,ndesc,nf;
    gpfunc *func;
    gpdesc *gd;
    if (!fgets(buf,BUFFER_SIZE,dfile))
      break;
    if (!*buf)
      die(err_desc,"Bad description file %s",descfile);
    buf[strlen(buf)-1]=0;
    nf=getfunc(buf); func=lfunc+nf;
    nb=readnumber(dfile,buf,BUFFER_SIZE);/*number of description*/
    if (nb<0)
      die(err_desc,"Bad description file %s, func %s",descfile,func->gpname);
    gd=newdesc(nb); ndesc=0;
    for(i=0;i<nb;i++)
    {
      int j,nargs;
      char *data;
      readentry(dfile,buf,BUFFER_SIZE);
      data=strdup(buf);
      nargs=readnumber(dfile,buf,BUFFER_SIZE);
      if (nargs>=0)
      {  /* This is a description*/
        gpdescarg *da=gd->a+(ndesc++);
        da->cname=data;
        da->nargs=nargs;
        if (nargs)
          da->args=calloc(nargs,sizeof(*da->args));
        else
          da->args=NULL;
        for(j=0;j<nargs;j++)
        {
          readentry(dfile,buf,BUFFER_SIZE);
          da->args[j]=strtoargs(buf);
        }
        da->type=readtypemode(dfile,buf,BUFFER_SIZE,&da->mode);
      }
      else
      {
        switch(-nargs)
        {
        case 1: /*This is a prototype*/
          func->proto.cname=data;
          readentry(dfile,buf,BUFFER_SIZE);
          func->proto.code=strdup(buf);
          functype(*func)=readtypemode(dfile,buf,BUFFER_SIZE,&funcmode(*func));
          break;
        default:
          die(err_desc,"Unknown description type %d in %s",nargs,descfile);
        }
      }
    }
    gd->nb=ndesc;
    func->dsc=ndesc?gd:NULL;
  }
  fclose(dfile);
}

int
descrulescore(int nb, int *args, gpdescarg *ga, int * const psc,int * const pesc, gpfunc *gp)
{
  int sc=0, esc=0;
  int i,j;
  descargatom *da=ga->args;
  for (i=0, j=0;j<ga->nargs;j++, i++)
  {
    int t;
    int arg=(i<nb)?args[i]:GNOARG;
    if (da[j].t==AAstdarg)
    {
      if (j==0)
        die(err_desc,"No argument before ellipsis  (...)");
      if (i>=nb)
        break;
      j--;
    }
    if (arg==GNOARG)
    {
      if (da[j].t==AAnoarg || da[j].t==AAoptsmall || da[j].t==AAopttype)
      {
        esc++;
        if (i>=nb)
          sc++;
        continue;
      }
      return 1;
    }
    if (arg<0)
      die(err_desc,"Internal error: Bad argument in descfindrules");
    if (da[j].mode>=0)
    {
      if ((tree[arg].m&da[j].mode)==da[j].mode)
        esc++;
      else
        return 1;
    }
    t=tree[arg].t;
    switch(da[j].t)
    {
    case AAopttype: /* Since arg is not GNOARG, arg is present */
    case AAtype:
      if (t==da[j].type)
        esc++;
      if (is_subtype(t,da[j].type))
        break;
      if (is_subtype(da[j].type,t))
        sc++;
      else
        return 1;
      break;
    case AActype:
      if (ctype[t]==da[j].misc)
        esc++;
      else
        return 1;
      break;
    case AAoptsmall: /* Since arg is not GNOARG, arg is present */
    case AAsmall:
      if (tree[arg].f==Fsmall && tree[arg].x==da[j].misc)
        esc++;
      else
        return 1;
      break;
    case AAstring:
      if (is_const(arg,CSTstr) &&  strcmp(entryname(arg),da[j].str)==0)
        esc++;
      else
        return 1;
      break;
    case AAreftype:
      if (t==da[j].type)
        esc++;
      if (tree[arg].f==Frefarg && is_subtype(da[j].type,t)
                               && ctype[t]==ctype[da[j].type])
        break;
      return 1;
    case AAherevalue:
      if (t==da[j].type && (tree[arg].f==Fsmall || tree[arg].f==Fconst))
      {
        esc++;
        break;
      }
      return 1;
    case AAlvalue:
      if (t==da[j].type && getlvalue(arg)>=0)
        esc++;
      else
        return 1;
      break;
    case AAmulti:
      if (tree[arg].f==Fentry || tree[arg].f==Fsmall)
        break;
      return 1;
    case AAnoarg:/* Since arg is not GNOARG, reject*/
      return 1;
    default:
      die(err_desc,"Internal error unknown AAvalue in descrulescore");
    }
  }
  if (i<nb) return 1;
  *psc=sc; *pesc=esc;
  return 0;
}

gpdescarg *descfindrules(int nb, int *arg, gpfunc *gp)
{
  int i;
  int best=-1,score=-1,escore=-1;
  gpdesc *dsc=gp->dsc;
  gpdescarg *ga=dsc->a;
  for(i=0;i<dsc->nb;i++)
  {
    int sc=0, esc=0;
    if (descrulescore(nb,arg,ga+i,&sc,&esc,gp))
      continue;
    if (best==-1 || sc<score || (sc==score &&  esc>escore ))
    {
      score=sc;
      escore=esc;
      best=i;
    }
  }
  return (best==-1)?NULL:ga+best;
}

gpdescarg *descfindrules1(int arg, int nf)
{
  return descfindrules(1, &arg, lfunc+nf);
}

int gentypefuncdesc(int n, gpfunc *gp)
{
  int arg[STACKSZ];
  int nb;
  int y=tree[n].y;
  gpdescarg *rule;
  if ( y!=-1 )
  {
    gentype(y);
    tree[n].m|=tree[y].m&MODHERIT;
  }
  nb=genlistargs(n,arg,0,STACKSZ);
  rule=descfindrules(nb,arg,gp);
  if (!rule)
    return Gnotype;
  tree[n].m|=rule->mode;
  return rule->type;
}

enum {FBparens, FBlong, FBstdref} flagbit;

00371 struct rpn_data
{
  FILE *fout;
  gpdescarg *rule;
  int nbarg;
  int *arg;
  int nerr;
  int sp;
  long flag;
};

static int get_arg(struct rpn_data *d, int n)
{
  if (n<=d->nbarg)
    return d->arg[n-1];
  return GNOARG;
}

static int get_str(struct rpn_data *d, int n)
{
  int x=get_arg(d,n);
  if (tree[x].f!=Fconst && value[tree[x].x].type!=CSTstr)
    die(n,"Constant string expected");
  return x;
}

static descargatom* get_atom(struct rpn_data *d, int n)
{
  if(n>d->rule->nargs) die(d->nerr,"Too few parameters");
  return d->rule->args+n-1;
}

static void cast_flag(struct rpn_data *d, int n, int t)
{
  if (d->flag&(1<<FBlong))
    gencastl(d->fout,n,t,d->flag&(1<<FBparens));
  else
    gencastf(d->fout,n,t,d->flag&(1<<FBparens));
}

#define RPN(f) void (f)(struct rpn_data *d, int *stk)

00413 struct rpn_func
{
  char *name;
  int arity;
  RPN(*function);
};

#define pop(n)  d->sp-=(n)
#define push(n) d->sp+=(n)
#define LVL(n)  (stk[d->sp-1-(n)])

RPN(rpn_add) {LVL(1)+=LVL(0); pop(1);}
RPN(rpn_sub) {LVL(1)-=LVL(0); pop(1);}
RPN(rpn_mul) {LVL(1)*=LVL(0); pop(1);}
RPN(rpn_div) {LVL(1)/=LVL(0); pop(1);}
RPN(rpn_mod) {LVL(1)%=LVL(0); pop(1);}

RPN(rpn_and) {LVL(1)&=LVL(0); pop(1);}
RPN(rpn_or)  {LVL(1)|=LVL(0); pop(1);}
RPN(rpn_xor) {LVL(1)^=LVL(0); pop(1);}

RPN(rpn_neg) {LVL(0)=-LVL(0);}
RPN(rpn_not) {LVL(0)=!LVL(0);}

RPN(rpn_nbarg)  {push(1);LVL(0)=d->nbarg;}

RPN(rpn_parens) {d->flag|=1<<FBparens;}
RPN(rpn_long)   {d->flag|=1<<FBlong;}
RPN(rpn_stdref)   {d->flag|=1<<FBstdref;}

RPN(rpn_str_format) { genpercent(d->fout, get_str(d, LVL(0))); pop(1); }
RPN(rpn_str_raw)    { fprintf(d->fout, entryname(get_str(d, LVL(0)))); pop(1); }
RPN(rpn_type) { LVL(0)=get_atom(d, LVL(0))->type; }

RPN(rpn_value)
{
  int n=get_arg(d,LVL(0));
  if (tree[n].f!=Fsmall) die(n,"Not an immediate small");
  LVL(0)=tree[n].x;
}

RPN(rpn_cast)
{
  int n=get_arg(d,LVL(1));
  int cast=LVL(0);
  descargatom *r=get_atom(d, LVL(1));
  int t=(cast==-1)?r->type:cast;
  switch(r->t)
  {
  case AAstdarg:
    {
      int i;
      int x=LVL(1)-1;
      if (x==0) die(d->nerr,"No argument before ellipsis  (...)");
      t=r[-1].type;
      for(i=x-1;i<d->nbarg;i++)
      {
        if (i>=x) fprintf(d->fout,", ");
        if (d->flag&(1<<FBstdref))
          fprintf(d->fout,"&");
        gencast(d->fout,d->arg[i],t);
      }
    }
    break;
  case AAoptsmall:
    fprintf(d->fout,"%d",r->misc);
    break;
  case AAopttype:
    if (n==GNOARG)
      gencodenoarg(d->fout,t,n);
    else
      cast_flag(d,n,t);
    break;
  case AActype:
    if (cast==-1) t=tree[n].t;
  default: /*Fall through*/
    cast_flag(d,n,t);
    break;
  }
  pop(2);
}

RPN(rpn_code) { push(1); LVL(0)=-1; rpn_cast(d,stk); }

RPN(rpn_format_string)
{
  int x=LVL(0)-1;
  int i,j;
  int arg[STACKSZ];
  if (x==0) die(d->nerr,"Ellipsis at start of description");
  for(j=x-1;j<d->nbarg;j++)
  {
    int nb=genlistcats(d->arg[j],arg,STACKSZ);
    for(i=0;i<nb;i++)
    {
      int n=arg[i];
      if (n==GNOARG) continue;
      if (genfuncbydesc1(d->fout,n,FC_formatcode,n))
        die(n,"No format for %s arg",GPname(tree[n].t));
    }
  }
  pop(1);
}

RPN(rpn_format_args)
{
  int x=LVL(0)-1;
  int arg[STACKSZ];
  int i,j;
  if (x==0) die(d->nerr,"Ellipsis at start of description");
  for(j=x-1;j<d->nbarg;j++)
  {
    int nb=genlistcats(d->arg[j],arg,STACKSZ);
    for(i=0;i<nb;i++)
    {
      gpdescarg *rule;
      int n=arg[i];
      if (n==GNOARG) continue;
      rule=descfindrules1(n, FC_formatcode);
      if (!rule) die(n,"Not format for %s arg",GPname(tree[n].t));
      if (rule->type!=Gvoid)
      {
        fprintf(d->fout,", ");
        gencast(d->fout,arg[i],rule->type);
      }
    }
  }
  pop(1);
}

const char *gencoderpn(FILE *fout, const char *p, gpdescarg *rule, int nbarg, int *arg, int nerr)
{
  int stk[STACKSZ];
  struct rpn_data data;
  const char *ps = p+1;
  struct rpn_func rpn[] =
  {
    {"add",2,rpn_add},{"sub",2,rpn_sub},{"neg",1,rpn_neg},
    {"mul",2,rpn_mul},{"div",2,rpn_div},{"mod",2,rpn_mod},
    {"and",2,rpn_and},{"or",2,rpn_or},{"xor",2,rpn_xor},{"not",1,rpn_not},
    {"value",1,rpn_value},{"type",1,rpn_type},{"nbarg",0,rpn_nbarg},
    {"parens",0,rpn_parens},{"long",0,rpn_long},{"stdref",0,rpn_stdref},
    {"str_format",1,rpn_str_format},{"str_raw",1,rpn_str_raw},
    {"code",1,rpn_code},{"cast",2,rpn_cast},
    {"format_string",1,rpn_format_string}, {"format_args",1,rpn_format_args},
    {NULL,0,NULL}
  };
  data.fout=fout;
  data.rule=rule;
  data.nbarg=nbarg;
  data.arg=arg;
  data.nerr=nerr;
  data.flag=0;
  data.sp=0;
  for(;;p++)
  {
    if (!*p) die(nerr,"Unfinished ${} in description");
    if (*p==' ' || *p=='}' )
    {
      size_t l=p-ps;
      if (isdigit(ps[0]) || ps[0]=='-')
        stk[data.sp++]=strtol(ps,NULL,10);
      else if (ps[0]==':')
        stk[data.sp++]=strtotype_len(ps+1,l-1);
      else
      {
        int r;
        for(r=0; rpn[r].name; r++)
        {
          const char *name=rpn[r].name;
          if (l==strlen(name) && !strncmp(ps,name,l))
          {
            if (rpn[r].arity>data.sp)
              die(nerr,"Too few arguments for %s",name);
            rpn[r].function(&data,stk);
            break;
          }
        }
        if(!rpn[r].name)
          die(nerr,"Unknown description command %s",xstrndup(ps,l));
      }
      ps=p+1;
      if(*p=='}')
        break;
    }
  }
  if (data.sp)
    fprintf(fout,"%d",stk[--data.sp]);
  return p;
}

void gencodedesc(FILE *fout, int nb, int *arg, gpdescarg *rule, int nerr)
{
  char buf[STACKSZ];
  const char *p;
  int mode;
  p=rule->cname;
  mode=0;
  do
  {
    switch(mode)
    {
    case 0:
      if (*p=='$')
        mode=1;
      else if (*p)
        fputc(*p,fout);
      break;
    case 1:
      switch(*p)
      {
      case '$':
        mode=0;
        fprintf(fout,"$");
        break;
      case '"':
        {
          char *s=memccpy(buf,p+1,'"',STACKSZ-1);
          if (!s)
            die(nerr,"Unfinished \" in description");
          *(s-1)=0;
          die(nerr,buf);
        }
      case 0:
        die(nerr,"Unfinished $ in description");
      case '{':
        p=gencoderpn(fout, p, rule, nb, arg, nerr);
        mode=0;
        break;
      default:
        die(nerr,"Unknown description");
      }
    }
  } while(*p++);
}

int genfuncbydesc(FILE *fout, int nb, int *arg, int nf, int nerr)
{
  gpdescarg *rule=descfindrules(nb, arg, lfunc+nf);
  if (!rule)
    return 1;
  gencodedesc(fout,nb, arg, rule, nerr);
  return 0;
}

int genfuncbydesc1(FILE *fout, int arg, int nf, int nerr)
{
  return genfuncbydesc(fout, 1, &arg, nf, nerr);
}

Generated by  Doxygen 1.6.0   Back to index