R-alpha: UseMethod()

Gregory R. Warnes (warnes@biostat.washington.edu)
Fri, 6 Sep 1996 18:20:32 -0700 (PDT)


Date: Fri, 6 Sep 1996 18:20:32 -0700 (PDT)
From: "Gregory R. Warnes" <warnes@biostat.washington.edu>
To: r-testers <r-testers@stat.math.ethz.ch>
Subject: R-alpha: UseMethod() 


I notice that R's UseMethod requires two arguments, as in the call for print:
> print
function (x, ...) 
UseMethod("print", x, ...)

However, SPlus's UseMethod uses only one argument:
> print
function(x, ...)
UseMethod("print")

I have a number of functions that call UseMethod, and would rather not 
have two copies, one for SPlus and one for R.  It seems that it should be 
possible to modify do_usemethod to grab the appropriate parameters from 
the parent's call using syscall(sysparent(1,env)).  

I can get the call correctly, but I don't know enough about the internal 
representation of the value that syscall returns to pull out the 
parameters to pass as args to the new method.  

Attached below is my _nonfunctional_ attempted hack.  Pointers would be 
appreciated.

-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes@biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------

--- objects.c.orig      Fri Sep  6 16:56:15 1996
+++ objects.c   Fri Sep  6 18:17:14 1996
@@ -132,20 +132,43 @@
 SEXP do_usemethod(SEXP call, SEXP op, SEXP args, SEXP env)
 {
        char buf[128];
-       SEXP ans;
+       SEXP ans, t;
+       RCNTXT *cptr;
 
        int nargs = length(args);
-       if(nargs < 2)
+       if(nargs < 1)
+       {
                errorcall(call, "too few arguments to UseMethod\n");
+       }
+
 
        if(TYPEOF(CAR(args)) != STRSXP || LENGTH(CAR(args)) < 1)
                errorcall(call, "first argument must be a method name\n");
        strcpy(buf, CHAR(STRING(CAR(args))[0]));
-       if(usemethod(buf, call, CDR(args), env, &ans) == 1)
-               return ans;
+
+       if (nargs==1)
+       {
+               cptr=R_GlobalContext;
+               t=cptr->sysparent;
+               while(cptr != NULL) {
+                               if(cptr->callflag == CTXT_RETURN)
+                               /*if(cptr->cloenv==t)*/
+                                       break;
+                       cptr = cptr->nextcontext;
+               }
+               if(cptr == NULL )
+                       error("GW: failed to match environments\n");
+               args = CDR(syscall(sysparent(1, cptr),cptr));
+
+       }
        else
-               error("no applicable method for \"%s\"\n", buf);
-}
+       {
+               if(usemethod(buf, call, CDR(args), env, &ans) == 1)
+                       return ans;
+               else
+                       error("no applicable method for \"%s\"\n", buf);
+               }
+       }
 
 SEXP do_unclass(SEXP call, SEXP op, SEXP args, SEXP env)
 {

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- To (un)subscribe, send
subscribe	or	unsubscribe
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-