SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/src/Mutils.h
ViewVC logotype

Diff of /pkg/Matrix/src/Mutils.h

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2354, Mon Mar 30 15:31:23 2009 UTC revision 2364, Sat Apr 18 23:32:30 2009 UTC
# Line 270  Line 270 
270      }      }
271  }  }
272    
273  /**  int Matrix_check_class_etc(SEXP x, char **valid);
274   * Return the 0-based index of an is() match in a vector of class-name  int Matrix_check_class_and_super(SEXP x, char **valid, SEXP rho);
  * strings terminated by an empty string.  Returns -1 for no match.  
  *  
  * @param x  an R object, about which we want is(x, .) information.  
  * @param valid vector of possible matches terminated by an empty string.  
  * @param rho  the environment in which the class definitions exist.  
  *  
  * @return index of match or -1 for no match  
  */  
 static R_INLINE int  
 Matrix_check_class_and_super(SEXP x, char **valid, SEXP rho)  
 {  
     int ans;  
     SEXP cl = getAttrib(x, R_ClassSymbol);  
     char *class = strdup(CHAR(asChar(cl)));  
     for (ans = 0; ; ans++) {  
         if (!strlen(valid[ans]))  
             break;  
         if (!strcmp(class, valid[ans])) return ans;  
     }  
     /* if not found directly, now search the non-virtual super classes :*/  
     if(IS_S4_OBJECT(x)) {  
         /* now try the superclasses, i.e.,  try   is(x, "....") : */  
         SEXP classExts = GET_SLOT(eval(lang2(install("getClassDef"), cl), rho),  
                                   install("contains")),  
             superCl = eval(lang3(install(".selectSuperClasses"),  
                                  classExts,  
                                  /* dropVirtual = */ ScalarLogical(1)),  
                            rho);  
         int i;  
         const char *s_class;  
         for(i=0; i < length(superCl); i++) {  
             s_class = CHAR(STRING_ELT(superCl, i));  
             for (ans = 0; ; ans++) {  
                 if (!strlen(valid[ans]))  
                     break;  
                 if (!strcmp(s_class, valid[ans])) return ans;  
             }  
         }  
     }  
     return -1;  
 }  
   
 /**  
  * Return the 0-based index of an is() match in a vector of class-name  
  * strings terminated by an empty string.  Returns -1 for no match.  
  *  
  * @param x  an R object, about which we want is(x, .) information.  
  * @param valid vector of possible matches terminated by an empty string.  
  *  
  * @return index of match or -1 for no match  
  */  
 static R_INLINE int  
 Matrix_check_class_etc(SEXP x, char **valid)  
 {  
     SEXP cl = getAttrib(x, R_ClassSymbol),  
         pkg = getAttrib(cl, install("package")), /* ==R== packageSlot(class(x)) */  
         rho = (isNull(pkg) ? R_GlobalEnv  
                : eval(lang2(install(".M.classEnv"), cl), R_GlobalEnv));  
     return Matrix_check_class_and_super(x, valid, rho);  
 }  
   
275    
276  #ifdef __cplusplus  #ifdef __cplusplus
277  }  }

Legend:
Removed from v.2354  
changed lines
  Added in v.2364

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge