# returnsLoopValue takes an expression and returns TRUE
# if its value could be the value of a for/while/repeat loop.
returnsLoopValue <- function(e) UseMethod("returnsLoopValue")
`returnsLoopValue.default` <-
    function(e)is.element(class(e), c("for","while","repeat"))
`returnsLoopValue.{` <- function(e)returnsLoopValue(e[[length(e)]]) # match }
`returnsLoopValue.(` <- function(e)returnsLoopValue(e[[length(e)]]) # match )
# Note: parse(test="function(x)x+1") returns call to `function`, not
# a function itself, so following won't be used while processing
# parse's output.
`returnsLoopValue.function` <- function(e)returnsLoopValue(functionBody(e))
# Note: Quote(if(x)"yes" else "no") is of class "if", not a call to "if".
`returnsLoopValue.if` <- function(e)returnsLoopValue(e[[3]])||((length(e)>3)&&returnsLoopValue(e[[4]]))

functionReturnsLoopValue <- function(file, expr = parse(file)) {
   require(codetools)
   returnLoopValueOffenders <- list()
   w <- makeCodeWalker(
      call=function(e,w){
         if(e[[1]]==as.name("function")){
            if (returnsLoopValue(e[[3]]))
               returnLoopValueOffenders[[length(returnLoopValueOffenders)+1]] <<- e
         };
         for(ee in as.list(e))
             if (!missing(ee))
                walkCode(ee,w)},
      leaf=function(e,w)NULL
   )
   lapply(expr, walkCode, w)
   attr(returnLoopValueOffenders, "srcfile") <- attr(expr, "srcfile")
   returnLoopValueOffenders
}

functionAssignsLoopValue <- function(file, expr = parse(file)) {
   require(codetools)
   assignLoopValueOffenders <- list()
   assignmentStack <- character()
   handlerEnv <- new.env()
   handlerEnv$`<-` <- function(e, w) {
      assignmentStack[length(assignmentStack)+1] <<- deparse(e[[2]])[1]
      if (returnsLoopValue(e[[3]])) {
         assignLoopValueOffenders[[length(assignLoopValueOffenders)+1]] <<- e
         names(assignLoopValueOffenders)[length(assignLoopValueOffenders)] <<- paste(assignmentStack, collapse=":")
      }
      walkCode(e[[3]], w)
      length(assignmentStack) <<- length(assignmentStack) - 1
      function(e,w)NULL
   }
   handlerEnv$`=` <- handlerEnv$`<<-` <- handlerEnv$`<-`
   w <- makeCodeWalker(
      handler=function(v, w) {
         handlerEnv[[v]]
      },
      call=function(e,w){
         # this handles any language object that handler doesn't supply a function for
         # cat("call: ", deparse(e)[1], "\n")
         for(ee in as.list(e))
             if (!missing(ee))
                walkCode(ee,w)
      },
      leaf=function(e,w) {
         if (typeof(e)=="pairlist") {
            for(name in names(e)) {
               if (!(is.name(e[[name]]) && nchar(as.character(e[[name]]))==0)) {
                  assignmentStack[length(assignmentStack)+1] <<- name
                  if (returnsLoopValue(e[[name]])) {
                     assignLoopValueOffenders[[length(assignLoopValueOffenders)+1]] <<- e[[name]]
                     names(assignLoopValueOffenders)[length(assignLoopValueOffenders)] <<- paste(assignmentStack, collapse=":")
                  }
                  walkCode(e[[name]], w)
                  length(assignmentStack) <<- length(assignmentStack) - 1
               }
            }
         }
         NULL # default prints the leaves of the parse tree
      }
   )
   lapply(expr, walkCode, w)
   attr(assignLoopValueOffenders, "srcfile") <- attr(expr, "srcfile")
   assignLoopValueOffenders
}