Changeset 358740 in git

Timestamp:

Dec 17, 2014, 5:07:14 PM (9 years ago)

Author:

Hans Schoenemann <hannes@…>

Branches:

(u'spielwiese', 'd0474371d8c5d8068ab70bfb42719c97936b18a6')

Children:

6b11c4c31a9405d61763d6cdb3862a3fac462317

Parents:

fce947c9e6c3e8c6d5a622c7f6b0d724580993cc

git-author:

Hans Schoenemann <hannes@mathematik.uni-kl.de>2014-12-17 17:07:14+01:00

git-committer:

Hans Schoenemann <hannes@mathematik.uni-kl.de>2014-12-17 18:08:50+01:00

Message:

add: access to fetch internals

Files:

• Singular/iparith.cc (modified) (5 diffs)
• Singular/table.h (modified) (2 diffs)
• doc/reference.doc (modified) (previous)

Singular/iparith.cc

@@ -6869 +6869 @@
   res->data=(char *)id;
   return FALSE;
+}
+static BOOLEAN jjFETCH_M(leftv res, leftv u)
+{
+  ring r=(ring)u->Data();
+  leftv v=u->next;
+  leftv perm_var_l=v->next;
+  leftv perm_par_l=v->next->next;
+  if ((perm_var_l->Typ()!=INTVEC_CMD)
+  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
+  ||(u->Typ()!=RING_CMD))
+  {
+    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
+    return TRUE;
+  }
+  intvec *perm_var_v=(intvec*)perm_var_l->Data();
+  intvec *perm_par_v=NULL;
+  if (perm_par_l!=NULL)
+    perm_par_v=(intvec*)perm_par_l->Data();
+  idhdl w;
+  nMapFunc nMap;
+
+  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
+  {
+    int *perm=NULL;
+    int *par_perm=NULL;
+    int par_perm_size=0;
+    BOOLEAN bo;
+    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
+    {
+      // Allow imap/fetch to be make an exception only for:
+      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
+            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
+             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
+           ||
+           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
+            (rField_is_Zp(currRing, r->cf->ch) ||
+             rField_is_Zp_a(currRing, r->cf->ch))) )
+      {
+        par_perm_size=rPar(r);
+      }
+      else
+      {
+        goto err_fetch;
+      }
+    }
+    else
+      par_perm_size=rPar(r);
+    perm=(int *)omAlloc0((r->N+1)*sizeof(int));
+    if (par_perm_size!=0)
+      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
+    int i;
+    if (perm_par_l==NULL)
+    {
+      if (par_perm_size!=0)
+        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
+    }
+    else
+    {
+      if (par_perm_size==0) WarnS("source ring has no parameters");
+      else
+      {
+        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--)
+        {
+          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
+        }
+      }
+    }
+    for(i=si_min(rVar(r),rVar(currRing))-1;i>=0;i--)
+    {
+      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
+    }
+    if (BVERBOSE(V_IMAP))
+    {
+      for(i=1;i<=si_min(r->N,currRing->N);i++)
+      {
+        if (perm[i]>0)
+          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
+        else if (perm[i]<0)
+          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
+      }
+      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
+      {
+        if (par_perm[i-1]<0)
+          Print("// par nr %d: %s -> par %s\n",
+              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
+        else if (par_perm[i-1]>0)
+          Print("// par nr %d: %s -> var %s\n",
+              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
+      }
+    }
+    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
+    sleftv tmpW;
+    memset(&tmpW,0,sizeof(sleftv));
+    tmpW.rtyp=IDTYP(w);
+    tmpW.data=IDDATA(w);
+    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
+                         perm,par_perm,par_perm_size,nMap)))
+    {
+      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
+    }
+    if (perm!=NULL)
+      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
+    if (par_perm!=NULL)
+      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
+    return bo;
+  }
+  else
+  {
+    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
+  }
+  return TRUE;
+err_fetch:
+  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
+         nCoeffString(r->cf),
+         nCoeffString(currRing->cf));
+  return TRUE;
 }
 static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
@@ -8224 +8340 @@
       while (dA3[i].cmd==op)
       {
-        if ((ai=iiTestConvert(at,dA3[i].arg1))!=0)
+        if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
         {
-          if ((bi=iiTestConvert(bt,dA3[i].arg2))!=0)
+          if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
           {
-            if ((ci=iiTestConvert(ct,dA3[i].arg3))!=0)
+            if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
             {
               res->rtyp=dA3[i].res;
@@ -8239 +8355 @@
                   iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
                   Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
-              failed= ((iiConvert(at,dA3[i].arg1,ai,a,an))
-                || (iiConvert(bt,dA3[i].arg2,bi,b,bn))
-                || (iiConvert(ct,dA3[i].arg3,ci,c,cn))
+              failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
+                || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
+                || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
                 || (call_failed=dA3[i].p(res,an,bn,cn)));
               // everything done, clean up temp. variables
@@ -8331 +8447 @@
 {
   memset(res,0,sizeof(sleftv));
-  BOOLEAN call_failed=FALSE;
 
   if (!errorreported)
@@ -8420 +8535 @@
 {
   memset(res,0,sizeof(sleftv));
-  BOOLEAN bo;
 
   if (!errorreported)

Singular/table.h

@@ -802 +802 @@
 ,{D(jjDBPRINT),   DBPRINT_CMD,     NONE,               -2      , ALLOW_PLURAL |ALLOW_RING}
 //,{D(jjEXPORTTO_M),  EXPORTTO_CMD,    NONE,             -2      , ALLOW_PLURAL |ALLOW_RING}
+,{D(jjCALL2ARG),  FETCH_CMD,       ANY_TYPE/*or set by p*/,2   , ALLOW_PLURAL |ALLOW_RING}
+,{D(jjFETCH_M),   FETCH_CMD,       ANY_TYPE/*or set by p*/,3   , ALLOW_PLURAL |ALLOW_RING}
+,{D(jjFETCH_M),   FETCH_CMD,       ANY_TYPE/*or set by p*/,4   , ALLOW_PLURAL |ALLOW_RING}
 ,{D(jjCALL1ARG),  IDEAL_CMD,       IDEAL_CMD,          1       , ALLOW_PLURAL |ALLOW_RING}
 ,{D(jjIDEAL_PL),  IDEAL_CMD,       IDEAL_CMD,          -1      , ALLOW_PLURAL |ALLOW_RING}
@@ -913 +916 @@
   { "factorize",   0, FAC_CMD ,           CMD_12},
   { "farey",       0, FAREY_CMD ,         CMD_2},
-  { "fetch",       0, FETCH_CMD ,         CMD_2},
+  { "fetch",       0, FETCH_CMD ,         CMD_M},
   { "fglm",        0, FGLM_CMD ,          CMD_2},
   { "fglmquot",    0, FGLMQUOT_CMD,       CMD_2},