languageEl <- ## extract an element of a language object, consistently ## for different kinds of objects. ## ## The 1st., etc. elements of a function are the corresponding ## formal arguments, with the default expression if any as value. ## ## The first element of a call is the name or the function object being ## called. The 2nd, 3rd, etc. elements are the 1st, 2nd, etc. arguments expressions. ## Note that the form of the extracted name is different for R and S-Plus. ## When the name (the first element) of a call is replaced, the languageEl replacement ## function coerces a character string to the internal form for each system. ## ## The 1st, 2nd, 3rd elements of an `if' expression are the test, first, and second branch. ## ## The 1st element of a `for' object is the name (symbol) being used in the loop, ## the second is the expression for the range of the loop, the third is the body of the loop. ## ## The first element of a `while' object is the loop test, and the second the body of ## the loop. function(object, which) { data <- as.list(object) if(is.character(which)) data[[which]] else if(typeof(object) == "language") { if(isGrammarSymbol(data[[1]])) data[[which + 1]] else data[[which]] ## other calls } else data[[which]] } "languageEl<-" <- ## replace an element of a language object, see "languageEl" for meaning. function(object, which, value) { data <- as.list(object) n <- length(data) type <- typeof(object) if(type == "closure") { ev <- environment(object) if(is.character(which)) { if(is.na(match(which, names(data)))) { body <- data[[n]] data <- data[-n] data[[which]] <- value data[[n+1]] <- body } else data[[which]] <- value } else { if(which < 1 || which > n) stop("Invalid index for function argument") ## we don't warn if this is used to replace the body (which == n) ## but maybe we should. data[[which]] <- value } object <- as.function(data) environment(object) <- ev object } else if(type == "language") { if(is.character(which)) data[[which]] <- value else if(isGrammarSymbol(data[[1]])) data[[which+1]] <- value else { if(identical(which, 1) && is.character(value)) value <- as.symbol(value) data[[which]] <- value } as.call(data) } else { object[[which]] <- value object } } isGrammarSymbol <- function(symbol) { if(typeof(symbol) != "symbol") FALSE else switch(as.character(symbol), ## the grammatical constructions "{" =, "if" = , "for"= , "while" = , "repeat" = , "return" = , "next" = , "break" = TRUE, FALSE) }