Added hook for lexacal scoping of formular. Formulas now contain the

environment in which they are created, currently stored as the .Environment
attribute.  The environment should only be accessed by the function
formula.environment to allow the storage to be changed.  print.formula
has been modified to strip off the .Environment attribute for printing.


git-svn-id: https://svn.r-project.org/R/trunk@9413 00db46b3-68df-0310-9c12-caf00c1e9a41

src/include/Rinternals.h

@@ -229,6 +229,7 @@ extern SEXP	R_TspSymbol;	    /* "tsp" */
 extern SEXP	R_LastvalueSymbol;  /* ".Last.value" */
 extern SEXP	R_CommentSymbol;    /* "comment" */
 extern SEXP	R_SourceSymbol;     /* "source" */
+extern SEXP	R_DotEnvSymbol;     /* ".Environment" */
 
 /* Missing Values - others from Arith.h */
 #define NA_STRING	R_NaString

src/library/base/R/models.R

@@ -30,7 +30,12 @@ formula.data.frame<- function (x, ...)
     eval(ff)
 }
 
-print.formula <- function(x, ...) print.default(unclass(x), ...)
+print.formula <- function(x, ...) {
+    attr(x, ".Environment") <- NULL
+    print.default(unclass(x), ...)
+}
+
+formula.environment <- function(x) attr(x,".Environment")
 
 "[.formula" <- function(x,i) {
     ans <- NextMethod("[")

src/main/model.c

@@ -1375,6 +1375,7 @@ SEXP do_tilde(SEXP call, SEXP op, SEXP args, SEXP rho)
     PROTECT(class = allocVector(STRSXP, 1));
     STRING(class)[0] = mkChar("formula");
     setAttrib(call, R_ClassSymbol, class);
+    setAttrib(call, R_DotEnvSymbol, rho);
     UNPROTECT(2);
     return call;
 }

src/main/names.c

@@ -779,6 +779,7 @@ static void SymbolShortcuts()
     R_TspSymbol = install("tsp");
     R_CommentSymbol = install("comment");
     R_SourceSymbol = install("source");
+    R_DotEnvSymbol = install(".Environment");
 }
 
 extern SEXP framenames; /* from model.c */